home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 47 / Amiga Format AFCD47 (Issue 131, Xmas 1999).iso / -serious- / misc / fwcalendar / fwcalendar.rexx < prev   
OS/2 REXX Batch file  |  1999-10-11  |  100KB  |  2,875 lines

  1. /*
  2.    FWCalendar.rexx Macro
  3.    Creates calendars on FinalWriter v 4.x (SoftWood) & PageStream v 3.x
  4.    $VER: FWCalendar.rexx v3.66 (20 Sep 1999)
  5.    ©Ron Goertz (goertz@earthlink.net)
  6. */
  7.  
  8. options results
  9. signal on syntax
  10.  
  11. PortList     = show('P')
  12. ErrorCount   = 0
  13. WarningCount = 0
  14.  
  15. call AddLibraries
  16. bguiopen = bguiopen()
  17. if ErrorCount > 0 then call Cleanup
  18.  
  19. address value DetermineHost()
  20. call SetVariables
  21. call GetLogInfo
  22. call GetSetupInfo
  23. call SetVariables
  24.  
  25. /*************************/
  26. /***//* Yearly Calendar  */
  27. /*************************/
  28. if CalType == 2 then do
  29.   EventCount = 389
  30.   if App == 'FW' then VIEW 20
  31.   else if App == 'PGS' then do
  32.     if DoHide == 1 then HIDEWINDOW
  33.     else DISPLAY SCALE 25
  34.     REFRESH OFF WINDOW winName
  35.   end
  36.   Req = OpenBusy(Generating$' 'Calendar' 'Calendar$'...', EventCount)
  37.  
  38.   Width.WidthOf1 = GetFontWidth(FYMiniCal, '1')
  39.   Width.WidthOf8 = GetFontWidth(FYMiniCal, '8')
  40.   call MiniCalPreCalc(FYMiniCal, MiniCalWidth)
  41.  
  42.   Year = EnteredYear
  43.   CalTop = Margin.Top
  44.   do r = 0 to 3
  45.     Margin.Top = CalTop + r * (7*Height.FYMiniCal + MiniCalSpacing)
  46.     do c = 0 to 2
  47.       Month = r * 3 + c + 1
  48.       Mn = right(Month, 2, '0')
  49.       TempDate = Year''Mn'01'
  50.       if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2 = 29
  51.       interpret 'StartDate = Day.'DateInfo('W', TempDate, 'S')
  52.       call DrawMiniCal(0, MiniCalWidth, FYMiniCal)
  53.     end
  54.   end
  55.  
  56.   if DoCopyright == 1 then call RightText(PrintText(0, CalTop + 28 * Height.FYMiniCal + 3 * MiniCalSpacing, 4pt, 'N', Color.Copyright, 100, CNotice), Margin.Left + PrintWidth)
  57.  
  58.   call Cleanup
  59. end
  60. /**/
  61.  
  62. /*************************/
  63. /***//* Monthly Calendar */
  64. /*************************/
  65. Year = EnteredYear
  66.  
  67. PrevMonth = Month - 1
  68. if PrevMonth = 0 then do
  69.   PrevMonth = 12
  70.   PrevYear = Year - 1
  71. end
  72. else PrevYear = Year
  73.  
  74. NextMonth = Month + 1
  75. if NextMonth = 13 then do
  76.   NextMonth = 1
  77.   NextYear = Year + 1
  78. end
  79. else NextYear = Year
  80.  
  81. if DoSunCalc ~= 0 then do
  82.   StartDST = DateInfo('I', Year'04'right(CalculateDate( 4, 'Monday', 7,  ''), 2, '0'), 'S') /* First Sunday in April */
  83.   EndDST   = DateInfo('I', Year'10'CalculateDate(10, 'Friday', 31, ''), 'S') /* Last Sunday in October */
  84. end
  85.  
  86. if DoPhases ~= 0 then CountPhases = 1
  87. if DoJulian ~= 0 then CountJulian = 1
  88. if DoJulianLeft ~= 0 then CountJulianLeft
  89. if DoSunRise ~= 0 then CountSunRise = 1
  90. if DoSunSet ~= 0 then CountSunSet = 1
  91. EventCount = 40 +,
  92.              (MonthLength.Month + 5) * (1 + CountSunRise + CountSunSet + DoDateBox + CountJulian + CountJulianLeft) +,
  93.              HighlightCount * (DoBackgrounds + DoHighlights) +,
  94.              (DoExtended*2 + 8) * DoBackgrounds +,
  95.              ImageCount * DoImages +,
  96.              DoMiniCals * (MonthLength.NextMonth + MonthLength.PrevMonth + 4) +,
  97.              CountPhases * 5
  98.  
  99. if App == 'FW' then VIEW 20
  100. else if App == 'PGS' then do
  101.   if DoHide == 1 then HIDEWINDOW
  102.   else DISPLAY SCALE 25
  103. end
  104. Req = OpenBusy(Generating$' 'Calendar' 'Calendar$'...', EventCount)
  105.  
  106. if (DoHighlights == 1) | (DoImages == 1) then call SetHighLights
  107. if DoPhases ~= 0 then call GetPhases(Year)
  108.  
  109. /************************/
  110. /* Finally, the program */
  111. /************************/
  112. if App == 'PGS' then do
  113.   if DoHide == 1 then REFRESH OFF WINDOW winName
  114. end
  115.  
  116. TempDate  = Year''Mn'01'
  117. IDay      = DateInfo('I', TempDate, 'S') - 1
  118. interpret 'StartYear = Day.'DateInfo('W', Year'0101', 'S')
  119.  
  120. if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then do
  121.   LeapYear = 1
  122.   MonthLength.2 = 29
  123. end
  124. else LeapYear = 0
  125.  
  126. if (PrevYear//4 == 0 & PrevYear//100 > 0) | PrevYear//400 == 0 Then PrevLeapYear = 1
  127. else PrevLeapYear = 0
  128.  
  129. interpret 'StartDate = Day.'DateInfo('W', TempDate, 'S')
  130.  
  131. /* In FW, TempDate is object ID 2                           */
  132. /* In PGS, no other objects should be drawn overlapping 0,0 */
  133. if App == 'FW' then SETTEXTBLOCKTEXT 2 'FWC'TempDate
  134. else if App == 'PGS' then call PrintText(0, 0, MiniCal, 'N', Color.White, Width.MiniCal, 'FWC'TempDate)
  135.  
  136. /***//* Draw dates and optional highlights */
  137. Day         = - StartDate
  138. LineTop.    = CalTop
  139. LineBottom. = CalTop + BoxHeight*5
  140. LineLeft.   = Margin.Left
  141. LineRight.  = CalRight
  142. BackBox.    = 0
  143.  
  144. Width.WidthOfDate1 = GetFontWidth(Date, '1')
  145. Width.WidthOfDate8 = GetFontWidth(Date, '8')
  146.  
  147. Do i = 0 to 5
  148.   if i = 5 then do
  149.     BoxTop = CalTop + BoxHeight*4.5
  150.     BHeight = BoxHeight/2
  151.   end
  152.   else do
  153.     BoxTop  = CalTop + BoxHeight*i
  154.     BHeight = BoxHeight
  155.   end
  156.                  
  157.   Do j = 0 to 6
  158.     Day = Day + 1
  159.     JulianDay = IDay + Day
  160.     BoxLeft = Margin.Left + BoxWidth * j
  161.  
  162.     /* Days for previous & next months */
  163.     If (Day < 1) | (Day > MonthLength.Month) then do
  164.  
  165.       /* Previous month */
  166.       if Day < 1 then do
  167.         PrintDay = MonthLength.PrevMonth + Day
  168.         LineTop.j = CalTop + BoxHeight
  169.         LineLeft.0 = Margin.Left + BoxWidth * (j + 1)
  170.       end
  171.  
  172.       /* Next month */
  173.       else do
  174.         PrintDay = Day - MonthLength.Month
  175.         interpret 'LineBottom.'j+1' = 'CalTop + BoxHeight*4
  176.         CalRow = i + 1
  177.         if LineRight.CalRow == CalRight then LineRight.CalRow = Margin.Left + BoxWidth * j
  178.       end
  179.  
  180.       if DoExtended then do
  181.         if (j = Day.Sunday | j = Day.Saturday) & (DoBackgrounds == 1) & (Background.Weekend ~= White$) then do
  182.           BackBox.JulianDay = DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 0, , 1, Background.Weekend, 1)
  183.           call UpdateBusy(Req, 1)
  184.         end
  185.  
  186.         DayType = 'Extended'
  187.         if BackBox.JulianDay ~= 0 then TextColor = AltColor.Extended
  188.         else TextColor = Color.Extended
  189.         DayID = PrintText(BoxLeft + DateOffset, BoxTop, Date, 'N', TextColor, Width.Date, PrintDay)
  190.         call UpdateBusy(Req, 1)
  191.         if DoDateBox == 1 then do
  192.           if BackBox.JulianDay ~= 0 then BoxColor = AltColor.Extended
  193.           else BoxColor = Color.Extended
  194.           call BoxDate(DayID, BoxColor)
  195.           call UpdateBusy(Req, 1)
  196.         end
  197.         call DoOptions
  198.       end
  199.     end
  200.  
  201.     /* Days for current month */
  202.     else do
  203.       if i = 5 then do
  204.         PrevJulianDay = JulianDay - 7
  205.         call DrawLine(BoxLeft, BoxTop, BoxLeft + BoxWidth, BoxTop, 'HL', Line.Grid)
  206.         if BackBox.PrevJulianDay ~= 0 then call HalveBox(BackBox.PrevJulianDay)
  207.         call UpdateBusy(Req, 1)
  208.       end
  209.  
  210.       if (j = Day.Sunday | j = Day.Saturday) & (DoBackgrounds == 1) & (Background.Weekend ~= White$) then BackBox.JulianDay = -1
  211.  
  212.       /* Print Highlight */
  213.       if Highlight.Month.Day ~= '' & DoHighlights == 1 then do
  214.         if TopOption ~= 0 then Highlight.Month.Day = '//'Highlight.Month.Day
  215.         DailyHLCount = 0
  216.         SearchPos    = 1
  217.         Found        = 1
  218.         do until Found = 0
  219.           Found = pos('//', Highlight.Month.Day, SearchPos)
  220.           if Found > 0 then do
  221.             HighlightText = substr(Highlight.Month.Day, SearchPos, Found - SearchPos)
  222.             SearchPos = Found + 2
  223.           end
  224.           else HighlightText = substr(Highlight.Month.Day, SearchPos)
  225.  
  226.           /* Draw background colors for highlight days */
  227.           if DoBackgrounds == 1 then do
  228.             if right(HighlightText, 1) == '#' then do
  229.               BoxColor = Background.HighlightH
  230.               if (BoxColor ~= White$) then TextColor = AltColor.HighlightH
  231.               else TextColor = Color.HighlightH
  232.             end
  233.             else do
  234.               BoxColor = Background.Highlight
  235.               if (BoxColor ~= White$) then TextColor = AltColor.Highlight
  236.               else TextColor = Color.Highlight
  237.             end
  238.             if (BackBox.JulianDay < 1 ) & (BoxColor ~= White$) then do
  239.               BackBox.JulianDay = DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 0, , 1, BoxColor, 1)
  240.               call UpdateBusy(Req, 1)
  241.             end
  242.           end
  243.           else do
  244.             if right(HighlightText, 1) == '#' then TextColor = Color.HighlightH
  245.             else TextColor = Color.Highlight
  246.           end
  247.  
  248.           Select
  249.             when Day < 10 then HighlightOffset = Width.WidthOfDate1 / 2 + Width.WidthOfDate8
  250.             when Day < 20 then HighlightOffset = 1.5 * Width.WidthOfDate1 + Width.WidthOfDate8
  251.             otherwise HighlightOffset = Width.WidthOfDate1 / 2 + 2 * Width.WidthOfDate8
  252.           end
  253.           TextLeft   = BoxLeft + DateOffset + HighlightOffset
  254.           call PrintHighlight(compress(HighlightText, '#'))
  255.           call UpdateBusy(Req, 1)
  256.  
  257.           DailyHLCount = DailyHLCount + 1
  258.         end
  259.       end
  260.  
  261.       if BackBox.JulianDay ~= 0 then TextColor = AltColor.Date
  262.       else TextColor = Color.Date
  263.  
  264.       /* Print Day */
  265.       DayType = 'Normal'
  266.       DayID = PrintText(BoxLeft + DateOffset, BoxTop, Date, 'N', TextColor, Width.Date, Day)
  267.       call UpdateBusy(Req, 1)
  268.       if DoDateBox == 1 then do
  269.         if BackBox.JulianDay ~= 0 then BoxColor = AltColor.Date
  270.         else BoxColor = Color.Date
  271.         call BoxDate(DayID, BoxColor)
  272.         call UpdateBusy(Req, 1)
  273.       end
  274.       call DoOptions
  275.       if BackBox.JulianDay == -1 then do
  276.         BackBox.JulianDay = DrawBox(BoxLeft, BoxTop, BoxWidth, BHeight, 0, , 1, Background.Weekend, 1)
  277.         call UpdateBusy(Req, 1)
  278.       end
  279.     end
  280.  
  281.     if (i = 5) & (Day = MonthLength.Month) then leave i
  282.   end
  283.   if Day >= MonthLength.Month then leave
  284. end
  285. /**/
  286.  
  287. /***//* Draw grids */
  288. LowRow = i
  289. if LowRow = 3 then LineBottom. = CalTop + BoxHeight*4
  290.  
  291. /* Draw vertical grid */
  292. do i = 0 to 7
  293.   LeftEdge = Margin.Left + BoxWidth*i
  294.   if DoExtended then do
  295.     if LineTop.i > CalTop then do
  296.       call DrawLine(LeftEdge, CalTop, LeftEdge, LineTop.i, 'HL', Line.Extended)
  297.       call UpdateBusy(Req, 1)
  298.     end
  299.     if LineBottom.i < LineBottom.8 then do
  300.       call DrawLine(LeftEdge, LineBottom.i, LeftEdge, LineBottom.8, 'HL', Line.Extended)
  301.       call UpdateBusy(Req, 1)
  302.     end
  303.   end
  304.   call DrawLine(LeftEdge, LineTop.i, LeftEdge, LineBottom.i, 'HL', Line.Grid)
  305.   call UpdateBusy(Req, 1)
  306. end
  307.  
  308. /* Draw horizontal grid */
  309. do i = 0 to min(LowRow + 1, 5)
  310.   TopEdge = CalTop + BoxHeight * i
  311.   if DoExtended then do
  312.     if LineLeft.i > Margin.Left then do
  313.       call DrawLine(Margin.Left, TopEdge, LineLeft.i, TopEdge, 'HL', Line.Extended)
  314.       call UpdateBusy(Req, 1)
  315.     end
  316.     if LineRight.i < CalRight then do
  317.       call DrawLine(LineRight.i, TopEdge, CalRight, TopEdge, 'HL', Line.Extended)
  318.       call UpdateBusy(Req, 1)
  319.     end
  320.   end
  321.   call DrawLine(LineLeft.i, TopEdge, LineRight.i, TopEdge, 'HL', Line.Grid)
  322.   call UpdateBusy(Req, 1)
  323. end
  324. /**/
  325.  
  326. /***//* Draw headers & minicals */
  327. /* Create month/year header */
  328. Text.Top = Margin.Top + ((7*Height.MiniCal) - Height.Header)/HeaderLoc
  329. MonthID = PrintText(Margin.Left, Text.Top , Header, 'N', Color.Header, Width.Header, upper(Month.Month' 'Year))
  330. call UpdateBusy(Req, 1)
  331.  
  332. /* Create weekday titles */
  333. Text.Top = CalTop - (Height.Weekday * 1.15)
  334. Do i = 0 to 6
  335.   WeekdayID.i = PrintText(1, Text.Top, Weekday, 'N', Color.Weekday, Width.Weekday, upper(Day.i))
  336.   call UpdateBusy(Req, 1)
  337. End
  338.  
  339. if App == 'FW' then REDRAW
  340.  
  341. /* Position month/year header */
  342. call CenterText(MonthID, Margin.Left + PrintWidth/2, .9 * (PrintWidth - DoMiniCals * (2 * MiniCalWidth)), 0)
  343. call UpdateBusy(Req, 1)
  344.  
  345. /* Position weekday titles */
  346. MaxWidth = GetMaxWidth('WeekdayID', 6)
  347.  
  348. Do i = 0 to 6
  349.   call CenterText(WeekdayID.i, Margin.Left + (i + .5) * BoxWidth, 0, .9 * min(1, BoxWidth/MaxWidth))
  350.   call UpdateBusy(Req, 1)
  351. end
  352.  
  353. if DoMiniCals = 1 then do
  354.   Width.WidthOf1 = GetFontWidth(MiniCal, '1')
  355.   Width.WidthOf8 = GetFontWidth(MiniCal, '8')
  356.   call MiniCalPreCalc(MiniCal, MiniCalWidth)
  357.   call DrawMiniCal(-1, MiniCalWidth, MiniCal)
  358.   call DrawMiniCal(+1, MiniCalWidth, MiniCal)
  359. end
  360. /**/
  361.  
  362. if DoCopyright == 1 then call RightText(PrintText(0, Margin.Top + PrintHeight, 4pt, 'N', Color.Copyright, 100, CNotice), Margin.Left + PrintWidth)
  363.  
  364. call Cleanup
  365. exit
  366. /**/
  367.  
  368. /*********************************************/
  369. /*              Subroutines                  */
  370. /*********************************************/
  371. /***//*******  AddLibraries () Subroutine  ***********/
  372. AddLibraries:
  373.   RequiredLibs = 'rexxsupport.library rexxbgui.library'
  374.   do i = 1 to words(RequiredLibs)
  375.     lib = word(RequiredLibs, i)
  376.     if exists('LIBS:'lib) then call addlib(lib, 0, -30, 0)
  377.     else call AddMsg('E', lib' is required but could not be found.')
  378.   end
  379.  
  380.   if ~exists('LIBS:bgui.library') then call AddMsg('E', 'bgui.library is required but could not be found.')
  381.  
  382.   if exists('LIBS:rexxtricks.library') then do
  383.     call addlib('rexxtricks.library', 0, -30, 0)
  384.     RexxTricks = 1
  385.   end
  386.   if exists('LIBS:rexxmathlib.library') then do
  387.     address command 'version >t:FWCTemp.txt libs:rexxmathlib.library'
  388.     call open('Temp', 't:FWCTemp.txt')
  389.       LibVersion = readln('Temp')
  390.     call close('Temp')
  391.     address command 'delete >NIL: t:FWCTemp.txt force quiet'
  392.     if trunc(strip(word(LibVersion, 2))) < 38 then do
  393.       call AddMsg('W', 'You have an old version of rexxmathlib.library (v 38.1+ required)')
  394.       call AddMsg('W', "  Contact the author if you can't find the new version")
  395.     end
  396.     else do
  397.       call addlib('rexxmathlib.library', 0, -30, 0)
  398.       MathLib = 1
  399.     end
  400.   end
  401.  
  402.   return
  403. /**/
  404.  
  405. /***//*******  AddMsg (AM) Subroutine  ***********/
  406. AddMsg:
  407.   parse arg AM_MsgType, AM_Msg
  408.  
  409.   if AM_MsgType == 'E' then do
  410.     ErrorCount = ErrorCount + 1
  411.     Error.ErrorCount = AM_Msg
  412.   end
  413.   else do
  414.     WarningCount = WarningCount + 1
  415.     Warning.WarningCount = AM_Msg
  416.   end
  417.  
  418.   return
  419. /**/
  420.  
  421. /***//*******  AssignHighlight (AH) Subroutine  ***********/
  422. AssignHighlight:
  423.   parse arg AH_Month, AH_Day, AH_Event
  424.  
  425.   if upper(left(AH_Month, 9)) == 'HIGHLIGHT' then do
  426.     AH_Event = strip(substr(AH_Month, pos('=', AH_Month) + 1))
  427.     if right(AH_Event, 2) == '*/' then AH_Event = strip(left(AH_Event, lastpos('/*', AH_Event) - 1))
  428.     AH_Event = substr(AH_Event, 2, Length(AH_Event) - 2)
  429.  
  430.     AH_DateString = DetermineDate1(AH_Month, AH_Day, AH_Event)
  431.     AH_Month = word(AH_DateString, 1)
  432.     AH_Day = word(AH_DateString, 2)
  433.   end
  434.  
  435.   AH_DateString = DetermineDate2(AH_Month, AH_Day)
  436.   AH_Month = word(AH_DateString, 1)
  437.   AH_Day = word(AH_DateString, 2)
  438.  
  439.   if Highlight.AH_Month.AH_Day == '' then Highlight.AH_Month.AH_Day = AH_Event
  440.   else Highlight.AH_Month.AH_Day = Highlight.AH_Month.AH_Day'//'AH_Event
  441.   HighlightCount = HighlightCount + 1
  442.  
  443.   do AH_i = 1 to ImageClassCount
  444.     if pos(ImageClass.AH_i, upper(AH_Event)) > 0 then do
  445.       Image.AH_Month.AH_Day = AH_i
  446.       ImageCount = ImageCount + 1
  447.       leave
  448.     end
  449.   end
  450.  
  451.   return 0
  452. /**/
  453.  
  454. /***//*******  AssignImage (AI) Subroutine  ***********/
  455. AssignImage:
  456.   parse arg AI_Month, AI_Day, AI_Image
  457.  
  458.   if upper(left(AI_Month, 5)) == 'IMAGE' then do
  459.     AI_Image = strip(substr(AI_Month, pos('=', AI_Month) + 1))
  460.     if right(AI_Image, 2) == '*/' then AI_Image = strip(left(AI_Image, lastpos('/*', AI_Image) - 1))
  461.     AI_Image = substr(AI_Image, 2, Length(AI_Image) - 2)
  462.  
  463.     AI_DateString = DetermineDate1(AI_Month, AI_Day, AI_Image)
  464.     AI_Month = word(AI_DateString, 1)
  465.     AI_Day = word(AI_DateString, 2)
  466.   end
  467.  
  468.   if (pos('/', AI_Image) == 0) & (pos(':', AI_Image) == 0) then AI_Image = ScriptDir'Images/'AI_Image
  469.  
  470.   AI_DateString = DetermineDate2(AI_Month, AI_Day)
  471.   AI_Month = word(AI_DateString, 1)
  472.   AI_Day = word(AI_DateString, 2)
  473.  
  474.   ImageClassCount = ImageClassCount + 1
  475.   Image.AI_Month.AI_Day = ImageClassCount
  476.   ImageClass.ImageClassCount = ''
  477.   ImageFile.ImageClassCount = AI_Image
  478.   return 0
  479. /**/
  480.  
  481. /***//*******  BoxDate (BD) Subroutine  ***********/
  482. BoxDate:
  483.   parse arg BD_ID, BD_DateBoxColor
  484.  
  485.   BD_DateBoxWidth = (DateOffset + GetWidth(BD_ID)) * 1.1
  486.   BD_DateBoxHeight = Height.Date
  487.  
  488.   call DrawBox(BoxLeft, BoxTop, BD_DateBoxWidth, BD_DateBoxHeight, 'HL', BD_DateBoxColor, 0, 0, 0)
  489.   return
  490. /**/
  491.  
  492. /***//*******  CalculateDate (CD) Subroutine  ***********/
  493. CalculateDate:
  494. /* Month    is the month in which the highlight occurs                        */
  495. /* HighDate is the highest (numerical) date on which the highlight will occur */
  496. /* HighDay  is the weekday on which the month starts when HighDate will occur */
  497. /* Event    is the highlight text                                             */
  498.   parse arg CD_Month, CD_HighDay, CD_HighDate, CD_Event
  499.  
  500.   if CD_Month = 13 then CD_Month = Mn - 0
  501.  
  502.   interpret 'CD_HighDay = Day.'CD_HighDay
  503.   interpret 'CD_First = Day.'DateInfo('W', Year''right(CD_Month, 2, '0')'01', 'S')
  504.  
  505.   CD_Day = CD_HighDate + (CD_HighDay - CD_First)
  506.   if CD_First < CD_HighDay then CD_Day = CD_Day - 7
  507.   if CD_Event ~= '' then call AssignHighlight(CD_Month, CD_Day, CD_Event)
  508.   else return CD_Day
  509. return 0
  510. /**/
  511.  
  512. /***//*******  CalculateEDate (CED) Subroutine  ***********/
  513. CalculateEDate:
  514. /* DaysPastEaster is the number of days past Easter when the event occurs */
  515. /* Event          is the highlight text                                   */
  516.   parse arg CED_DaysPastEaster, CED_EasterEvent
  517.  
  518.   if DoEaster == 1 then do
  519.     CED_EasterEventDate = DateInfo('S', EasterSerial + CED_DaysPastEaster, 'I')
  520.     CED_EasterEventMonth = strip(substr(CED_EasterEventDate, 5, 2), 'B', '0')
  521.     CED_EasterEventDay = strip(right(CED_EasterEventDate, 2), 'B', '0')
  522.     call AssignHighlight(CED_EasterEventMonth, CED_EasterEventDay, CED_EasterEvent)
  523.   end
  524. return 0
  525. /**/
  526.  
  527. /***//*******  CalculateImage (CI) Subroutine  ***********/
  528. CalculateImage:
  529. /* Month    is the month in which the highlight occurs                        */
  530. /* HighDate is the highest (numerical) date on which the highlight will occur */
  531. /* HighDay  is the weekday on which the month starts when HighDate will occur */
  532. /* Event    is the highlight text                                             */
  533.   parse arg CI_Month, CI_HighDay, CI_HighDate, CI_Event
  534.  
  535.   if CI_Month = 13 then CI_Month = Mn - 0
  536.  
  537.   interpret 'CI_HighDay = Day.'CI_HighDay
  538.   interpret 'CI_First = Day.'DateInfo('W', Year''right(CI_Month, 2, '0')'01', 'S')
  539.  
  540.   CI_Day = CI_HighDate + (CI_HighDay - CI_First)
  541.   if CI_First < CI_HighDay then CI_Day = CI_Day - 7
  542.   if CI_Event ~= '' then call AssignImage(CI_Month, CI_Day, CI_Event)
  543.   else return CI_Day
  544. return 0
  545. /**/
  546.  
  547. /***//*******  CenterText (CT) Subroutine  ***********/
  548. CenterText:
  549.   parse arg CT_id, CT_CenterPoint, CT_MaxWidth, CT_WidthPercent
  550.  
  551.   if App = 'FW' then do
  552.     GETOBJECTCOORDS CT_id; Parse Var result . . CT_Text.Bottom CT_Text.Width CT_Text.Height
  553.     if CT_MaxWidth ~= 0 then CT_Text.Width = min(CT_Text.Width, CT_MaxWidth)
  554.     else CT_Text.Width = CT_Text.Width * CT_WidthPercent
  555.     CT_Text.Left = CT_CenterPoint - CT_Text.Width/2
  556.     SETOBJECTCOORDS CT_id 1 CT_Text.Left CT_Text.Bottom CT_Text.Width CT_Text.Height
  557.   end
  558.   else if App == 'PGS' then do
  559.     GETTEXTOBJ POSITION CT_Text OBJECTID CT_id WINDOW winName
  560.     CT_Text.Width = CT_Text.Right - CT_Text.Left
  561.     if CT_MaxWidth ~= 0 then CT_Text.Width = min(CT_Text.Width, CT_MaxWidth)
  562.     else CT_Text.Width = CT_Text.Width * CT_WidthPercent
  563.     CT_Text.Left = CT_CenterPoint - CT_Text.Width/2
  564.     EDITTEXTOBJ POSITION CT_Text.Left CT_Text.Top (CT_Text.Left + CT_Text.Width) CT_Text.Bottom OBJECTID CT_id WINDOW winName
  565.   end
  566.   return
  567. /**/
  568.  
  569. /***//*******  Cleanup () Subroutine  ***********/
  570. Cleanup:
  571.   signal off syntax
  572.  
  573.   if Req ~= 0 then call bguiwinclose(Req)
  574.   if VariablesSet == 1 then do
  575.     interpret UserPrefs
  576.     if App == 'FW' then do
  577.       SELECTOBJECT
  578.       VIEW FinalView
  579.       if upper(DecimalFormat) = 'COMMA' then DOCITEMPREFS DECIMAL Comma
  580.     end
  581.     else if App == 'PGS' then do
  582.       SELECTOBJECT None WINDOW winName
  583.       LOCKINTERFACE FALSE
  584.       LOADSETTINGS default
  585.       DISPLAY SCALE FinalView WINDOW winName
  586.       REFRESH ON WINDOW winName
  587.       REFRESHWINDOW WINDOW winName
  588.       REVEALWINDOW WINDOW winName
  589.     end
  590.   end
  591.  
  592.   if (ErrorCount == 0) & (CalType == 1) & (LaunchM ~= '') then interpret LaunchM
  593.   if (ErrorCount == 0) & (CalType == 2) & (LaunchY ~= '') then interpret LaunchY
  594.  
  595.   LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
  596.   if LogOpen == 1 then OutType = 'File'
  597.   if ((WarningCount > 0) | (ErrorCount > 0)) & (LogOpen == 0) then do
  598.     LogOpen = 1
  599.     call open('FWCLog', 'CON:10/10/500/300/FWCalendar.rexx Message/WAIT/CLOSE')
  600.     OutType = 'CON'
  601.   end
  602.  
  603.   if LogOpen == 1 then do
  604.     call writeln('FWCLog', '      Macro: 'strip(substr(sourceline(4), pos(':', sourceline(4)) + 1)))
  605.     call writeln('FWCLog', 'Application: 'PgmVersion)
  606.     call writeln('FWCLog', 'Current Dir: 'CurrentDir)
  607.     call writeln('FWCLog', ' Script Dir: 'ScriptDir)
  608.     call writeln('FWCLog', '       Host: 'CallHost)
  609.     call writeln('FWCLog', '   Calendar: 'Calendar||'0a'x)
  610.   end
  611.  
  612.   if (ErrorCount > 0) | (WarningCount > 0) then do
  613.     do i = 1 to ErrorCount
  614.       call writeln('FWCLog', Error.i)
  615.     end
  616.  
  617.     do i = 1 to WarningCount
  618.       call writeln('FWCLog', Warning.i)
  619.     end
  620.  
  621.     if exists(ScriptDir''FWCData) then do
  622.       call writeln('FWCLog', '0a'x||' -- 'ScriptDir'FWCalendar.data -- ')
  623.       call open('DataFile', ScriptDir''FWCData)
  624.         do until eof('DataFile')
  625.           Ln = ReadLn('DataFile')
  626.           if pos('End Pass One', Ln) > 0 then
  627.             if (SettingHighlights ~= 1) & (ListHighlightData ~= 1) then leave
  628.           call writeln('FWCLog', Ln)
  629.         end
  630.       call close('DataFile')
  631.     end
  632.  
  633.     if ErrorCount > 0 then ErrorType = 'Critical error'
  634.     else ErrorType = 'Noncritical warning'
  635.     FileMsg = ErrorType' ... see 'Storage'FWCLog.txt for details.'||'0a'x||'Forward log file to: Ron Goertz <goertz@earthlink.net>'||'0a'x||'if you are unable to resolve the problem.'
  636.     Conbgui = ErrorType' ... see the shell output for details.'||'0a'x||'Forward contents of output to'||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||'if you are unable to resolve the problem.'
  637.     ConCon  = ErrorType' ... see the output above for details.'||'0a'x||'Forward contents of output to'||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||'if you are unable to resolve the problem.'
  638.     if (OutType == 'File') & (bguiopen == 1) then call bguireq('1B'x||'c'FileMsg,'*'OK$,'FWCalendar 'Notice$,,AppScreen)
  639.     if (OutType == 'File') & (bguiopen == 0) then do
  640.       call open('CON', 'CON:10/10/500/300/FWCalendar notice/WAIT/CLOSE')
  641.         call writeln('CON', FileMsg)
  642.       call close('CON')
  643.     end
  644.     if (OutType == 'CON') & (bguiopen == 1) then call bguireq('1B'x||'c'Conbgui,'*'OK$,'FWCalendar 'Notice$,,AppScreen)
  645.     if (OutType == 'CON') & (bguiopen == 0) then call Writeln('FWCLog', '0a'x||ConCon)
  646.   end
  647.   else do
  648.     if LogOpen == 1 then call writeln('FWCLog', 'No errors.')
  649.   end
  650.  
  651.   address command 'delete >NIL: 'Storage'FWC'App'Temp.txt quiet'
  652.   address command 'delete >NIL: 'Storage'FWCTemp quiet'
  653.   call close('FWCLog')
  654.   if bguiopen = 1 then call bguiclose()
  655.   if DefScreen ~= '' then call setdefaultpubscreen(DefScreen)
  656.   exit
  657. /**/
  658.  
  659. /***//*******  ConvertJ (CJ) Subroutine  ***********/
  660. /* Routine to convert from 'J' & 'F' to normal dates obtained from the Sky & Telescope */
  661. /* web site. The basic program from which the following was derived originally    */
  662. /* appeared in Astronomical Computing, Sky & Telescope, May, 1984                 */
  663. ConvertJ:
  664.   parse arg CJ_F, CJ_J
  665.  
  666.   CJ_F = CJ_F + 0.5
  667.   if CJ_F >= 1 then do
  668.     CJ_F = CJ_F - 1
  669.     CJ_J = CJ_J + 1
  670.   end
  671.   CJ_A1 = trunc((CJ_J / 36524.25) - 51.12264)
  672.   CJ_A = CJ_J + 1 + CJ_A1 - trunc(CJ_A1 / 4)
  673.   CJ_B = CJ_A + 1524
  674.   CJ_C = trunc((CJ_B / 365.25) - 0.3343)
  675.   CJ_D = trunc(365.25 * CJ_C)
  676.   CJ_E = trunc((CJ_B - CJ_D) / 30.61)
  677.   CJ_D = CJ_B - CJ_D - trunc(30.61 * CJ_E) + CJ_F
  678.   CJ_M = CJ_E - 1
  679.   CJ_Y = CJ_C - 4716
  680.   IF CJ_E > 13.5 then CJ_M = CJ_M - 12
  681.   IF CJ_M < 2.5 then CJ_Y = CJ_Y + 1
  682.   CJ_Day = trunc(CJ_D)
  683.  
  684.   return right(CJ_Y, 4, '0')' 'right(CJ_M, 2, '0')' 'right(CJ_Day, 2, '0')' 'CJ_D - CJ_Day
  685. /**/
  686.  
  687. /***//*******  ControlMX (CM) Subroutine  ***********/
  688. ControlMX:
  689.   parse arg CM_Group
  690.  
  691.   pos = pos.CM_Group
  692.  
  693.   do CM_i = 0 to 1
  694.     option = Option.pos
  695.     if option ~= 0 then do
  696.       do dst = 0 to GroupCount
  697.         if CM_Group = dst then iterate
  698.         interpret 'call bguiset('grp.dst',winID,'Action.CM_i','option')'
  699.  
  700.         if ((Do.option == 'Julian') | (Do.option == 'JulianLeft')) & ((CM_i = 1) | ((CM_i = 0) & (ActiveJulian == 1))) then
  701.           interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.BothJ')'
  702.         if Do.option = 'BothJ' then do
  703.           interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.Julian')'
  704.           interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.JulianLeft')'
  705.         end
  706.  
  707.         if ((Do.option == 'Sunrise') | (Do.option == 'Sunset')) & ((CM_i = 1) | ((CM_i = 0) & (ActiveSunCalc == 1))) then
  708.           interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.BothS')'
  709.         if Do.option = 'BothS' then do
  710.           interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.Sunrise')'
  711.           interpret 'call bguiset('grp.dst',winID,'Action.CM_i','MXPos.Sunset')'
  712.         end
  713.  
  714.       end
  715.     end
  716.     interpret 'Option.'pos' = bguiget('grp.CM_Group', MX_Active)'
  717.   end
  718.  
  719.   if (Do.option == 'Julian') | (Do.option == 'JulianLeft') then ActiveJulian.CM_Group = 1
  720.   else ActiveJulian.CM_Group = 0
  721.   if (Do.option == 'Sunrise') | (Do.option == 'Sunset') then ActiveSunCalc.CM_Group = 1
  722.   else ActiveSunCalc.CM_Group = 0
  723.  
  724.   ActiveJulian = 0
  725.   ActiveSunCalc = 0
  726.   do grp = 0 to GroupCount
  727.     ActiveJulian = ActiveJulian + ActiveJulian.grp
  728.     ActiveSunCalc = ActiveSunCalc + ActiveSunCalc.grp
  729.   end
  730.  
  731.   if ActiveJulian == 1 then
  732.     do grp = 0 to GroupCount
  733.       if ActiveJulian.grp == 1 then interpret 'call bguiset('grp.grp',winID,MX_EnableButton,'MXPos.BothJ')'
  734.     end
  735.  
  736.   if ActiveSunCalc == 1 then
  737.     do grp = 0 to GroupCount
  738.       if ActiveSunCalc.grp == 1 then interpret 'call bguiset('grp.grp',winID,MX_EnableButton,'MXPos.BothS')'
  739.     end
  740.  
  741.   return
  742. /**/
  743.  
  744. /***//*******  CreateDataFile () Subroutine  ***********/
  745. CreateDataFile:
  746.   if App == 'FW' then do
  747.     GETSECTIONSETUP Top Bottom Inside Outside
  748.     parse var result Margin.Top Margin.Bottom Margin.Left Margin.Right
  749.   end
  750.   else if App == 'PGS' then do
  751.     PageWidth     = 8.5
  752.     PageHeight    = 11
  753.     Margin.Top    = 0.5
  754.     Margin.Bottom = 0.5
  755.     Margin.Left   = 0.5
  756.     Margin.Right  = 0.5
  757.   end
  758.  
  759.   SL = 0
  760.   Value. = '00'x
  761.  
  762.   if ~exists(ScriptDir''ChangesFile) then do
  763.     do forever
  764.       VarLine = strip(SourceLine(VarLoc + SL))
  765.       VarName = word(VarLine, 1)
  766.       Value = strip(substr(VarLine, pos('=', VarLine) + 1))
  767.       if VarName == 'return' then leave
  768.       interpret VarLine
  769.       Var.SL = VarName
  770.       SL = SL + 1
  771.     end
  772.  
  773.     if exists(ScriptDir''FWCData) then do
  774.       if open('DataFile', ScriptDir''FWCData) then do
  775.         do until eof('DataFile')
  776.           VarLine = strip(ReadLn('DataFile'))
  777.           VarName = strip(word(VarLine, 1))
  778.           VarStem = left(VarName, pos('.', VarName))
  779.           VarCmpd = substr(VarName, pos('.', VarName) + 1)
  780.           Value   = strip(substr(VarLine, pos('=', VarLine) + 1))
  781.           select
  782.             when left(VarLine, 15) == '/* End Pass One' then do
  783.               HighlightStart = seek('DataFile', 0)
  784.               leave
  785.             end
  786.             when right(VarName, 1) == '$' then iterate
  787.             when left(VarLine, 2) == '/*' then iterate
  788.             when VarLine == '' then iterate
  789.             otherwise do
  790.               if (pos(VarStem, upper(ColorVars)) ~= 0) & (VarCmpd ~= 'WHITE') & (VarCmpd ~= '') then do
  791.                 ColorCount = ColorCount + 1
  792.                 ColorName.ColorCount = word(Ln, 1)
  793.                 interpret 'ColorValue.'ColorCount' = 'VarCmpd
  794.               end
  795.               do CheckVar = 0 to SL - 1
  796.                 if Var.CheckVar == VarName then leave
  797.               end
  798.               if CheckVar == SL then do
  799.                 Var.SL = VarName
  800.                 SL = SL + 1
  801.               end
  802.               interpret VarLine
  803.             end
  804.           end
  805.         end
  806.         call close('DataFile')
  807.       end
  808.     end
  809.  
  810.     call SetColor('Date')
  811.     call SetColor('Extended')
  812.     call SetColor('Highlight')
  813.     call SetColor('HighlightH')
  814.     call SetColor('Julian')
  815.     call SetColor('WeekNumber')
  816.     call SetColor('Sunrise')
  817.     call SetColor('Sunset')
  818.  
  819.     call WriteData
  820.   end
  821.  
  822.   return
  823. /**/
  824.  
  825. /***//*******  DateInfo () Subroutine  ***********/
  826. DateInfo: PROCEDURE
  827.   /* DateInfo('I', '19780101', 'S') = 2443510  */
  828.   /* Date('I', '19780101', 'S') = 0            */
  829.   /* Option 'C' returns days since Jan 1, xx00 */
  830.   parse arg Option, Date, Format
  831.  
  832.   if Option == '' then Option = 'N'
  833.   if Date == '' then do
  834.     Date = Date('S')
  835.     Format = 'S'
  836.   end
  837.  
  838.   Option = upper(left(Option, 1))
  839.   Format = upper(left(Format, 1))
  840.   if (Format == 'I') | (Format = '') then do
  841.     Format = 'I'
  842.  
  843.     /* Routine to convert from a serial date to year/month/day obtained from the        */
  844.     /* Sky & Telescope web site. The basic program from which the following was         */
  845.     /* derived originally appeared in Astronomical Computing, Sky & Telescope,May, 1984 */
  846.     A1 = trunc((Date / 36524.25) - 51.12264)
  847.     A = Date + 1 + A1 - trunc(A1 / 4)
  848.     B = A + 1524
  849.     C = trunc((B / 365.25) - 0.3343)
  850.     D = trunc(365.25 * C)
  851.     E = trunc((B - D) / 30.61)
  852.     D = B - D - trunc(30.61 * E)
  853.     Month = E - 1
  854.     Year = C - 4716
  855.     IF E > 13.5 then Month = Month - 12
  856.     IF Month < 2.5 then Year = Year + 1
  857.     Day = trunc(D)
  858.     J = Date
  859.   end
  860.   else do
  861.     Year  = left(Date, 4) - 0
  862.     Month = substr(Date, 5, 2) - 0
  863.     Day   = right(Date, 2) - 0
  864.     /* The following two lines are modified from PerpetualCalendar.bas that */
  865.     /* appeared in Astronomical Computing, Sky & Telescope, July, 1985      */
  866.     Temp = 0; if Month <= 2 then Temp = -1
  867.     J = 367*Year-trunc(7*(Year+trunc((Month + 9)/12))/4)+trunc(275*Month/9)+1721031-trunc(3*(trunc((Year+Temp)/100)+1)/4) + Day - 2
  868.   end
  869.  
  870.   select
  871.     when Option == 'B' then do
  872.       return J - 1721060
  873.     end
  874.     when Option == 'C' then do
  875.       return J + 2 - DateInfo('I', left(right(Year, 4, '0'), 2)'000101', 'S')
  876.     end
  877.     when (Option == 'D') | (Option == 'J') then do
  878.       DayCount = 0
  879.       MonthLength.1    = 31
  880.       MonthLength.2    = 28
  881.       MonthLength.3    = 31
  882.       MonthLength.4    = 30
  883.       MonthLength.5    = 31
  884.       MonthLength.6    = 30
  885.       MonthLength.7    = 31
  886.       MonthLength.8    = 31
  887.       MonthLength.9    = 30
  888.       MonthLength.10   = 31
  889.       MonthLength.11   = 30
  890.       MonthLength.12   = 31
  891.       if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2 = 29
  892.  
  893.       do I = (Month - 1) to 1 by -1
  894.         DayCount = DayCount + MonthLength.I
  895.       end
  896.       if Option == 'D' then return DayCount + Day
  897.       else return right(Year, 2)''right(DayCount + Day, 3, '0')
  898.     end
  899.     when Option == 'E' then do
  900.       return right(Day, 2, '0')'/'right(Month, 2, '0')'/'right(Year, 2, '0')
  901.     end
  902.     when Option == 'I' then return J
  903.     when (Option == 'M') | (Option == 'N') then do
  904.       Select
  905.         when Month ==  1 then Month = 'January'
  906.         when Month ==  2 then Month = 'February'
  907.         when Month ==  3 then Month = 'March'
  908.         when Month ==  4 then Month = 'April'
  909.         when Month ==  5 then Month = 'May'
  910.         when Month ==  6 then Month = 'June'
  911.         when Month ==  7 then Month = 'July'
  912.         when Month ==  8 then Month = 'August'
  913.         when Month ==  9 then Month = 'September'
  914.         when Month == 10 then Month = 'October'
  915.         when Month == 11 then Month = 'November'
  916.         when Month == 12 then Month = 'December'
  917.       end
  918.       if Option == 'M' then return Month
  919.       else return right(Day, 2, '0')' 'left(Month, 3)' 'Year
  920.     end
  921.     when Option == 'O' then return right(Year, 2, '0')'/'right(Month, 2, '0')'/'right(Day, 2, '0')
  922.     when Option == 'S' then return right(Year, 4, '0')''right(Month, 2, '0')''right(Day, 2, '0')
  923.     when Option == 'U' then return right(Month, 2, '0')'/'right(Day, 2, '0')'/'right(Year, 2, '0')
  924.     when Option == 'W' then do
  925.       J = J + 1
  926.       Weekday = J - 7 * trunc(J / 7)
  927.       Select
  928.         when Weekday == 0 then return 'Sunday'
  929.         when Weekday == 1 then return 'Monday'
  930.         when Weekday == 2 then return 'Tuesday'
  931.         when Weekday == 3 then return 'Wednesday'
  932.         when Weekday == 4 then return 'Thursday'
  933.         when Weekday == 5 then return 'Friday'
  934.         when Weekday == 6 then return 'Saturday'
  935.       end
  936.     end
  937.     otherwise return 0 /* date(Option, Date, Format) */
  938.   end
  939. /**/
  940.  
  941. /***//*******  DetermineDate1 (DD1) Subroutine  ***********/
  942. DetermineDate1:
  943.   parse arg DD1_Month, DD1_Day, DD1_Event
  944.  
  945.   DD1_Ln = DD1_Month
  946.   DD1_Month = pos('.', DD1_Ln) + 1
  947.   DD1_Day   = pos('.', DD1_Ln, DD1_Month) + 1
  948.   DD1_Event = pos('=', DD1_Ln) + 1
  949.   DD1_Month = substr(DD1_Ln, DD1_Month, DD1_Day - DD1_Month - 1)
  950.   if DD1_Month == '13' then DD1_Month = Mn - 0
  951.   DD1_Day   = upper(strip(substr(DD1_Ln, DD1_Day, DD1_Event - DD1_Day - 1)))
  952.   if left(DD1_Day, 2) = '32' then DD1_Day = overlay(MonthLength.DD1_Month, DD1_Day)
  953.   return DD1_Month' 'DD1_Day
  954. /**/
  955.  
  956. /***//*******  DetermineDate2 (DD2) Subroutine  ***********/
  957. DetermineDate2:
  958.   parse arg DD2_Month, DD2_Day
  959.  
  960.   DD2_DateString = Year''right(DD2_Month, 2, '0')''right(strip(DD2_Day, 'T', 'PN'), 2, '0')
  961.   DD2_Weekday = DateInfo('W', DD2_DateString, 'S')
  962.   if (right(DD2_Day, 1) == 'N') & (DD2_Weekday == 'Saturday') then do
  963.     DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') + 2), 'I')
  964.     DD2_Month = substr(DD2_NewDay, 5, 2) - 0
  965.     DD2_Day = substr(DD2_NewDay, 7, 2) - 0
  966.   end
  967.   else if (right(DD2_Day, 1) == 'P') & (DD2_Weekday == 'Saturday') then do
  968.     DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') - 1), 'I')
  969.     DD2_Month = substr(DD2_NewDay, 5, 2) - 0
  970.     DD2_Day = substr(DD2_NewDay, 7, 2) - 0
  971.   end
  972.   else if (right(DD2_Day, 1) == 'N') & (DD2_Weekday == 'Sunday') then do
  973.     DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') + 1), 'I')
  974.     DD2_Month = substr(DD2_NewDay, 5, 2) - 0
  975.     DD2_Day = substr(DD2_NewDay, 7, 2) - 0
  976.   end
  977.   else if (right(DD2_Day, 1) == 'P') & (DD2_Weekday == 'Sunday') then do
  978.     DD2_NewDay = DateInfo('S', (DateInfo('I', DD2_DateString, 'S') - 2), 'I')
  979.     DD2_Month = substr(DD2_NewDay, 5, 2) - 0
  980.     DD2_Day = substr(DD2_NewDay, 7, 2) - 0
  981.   end
  982.   DD2_Day = strip(DD2_Day, 'T', 'PN')
  983.  
  984.   return DD2_Month' 'DD2_Day
  985. /**/
  986.  
  987. /***//*******  DetermineHost () Subroutine  ***********/
  988. DetermineHost:
  989.   parse source . . . FullCallPath . CallHost
  990.   CallHost = strip(CallHost)
  991.   ScriptDir = PathPart(FullCallPath)
  992.  
  993.   CurrentDir = upper(Pragma('D'))
  994.   if right(CurrentDir, 1) ~= ':' then CurrentDir = CurrentDir'/'
  995.  
  996.   if exists('Envarc:Owner') then do
  997.     call open('OwnerName', 'Envarc:Owner')
  998.       owner = readln('OwnerName')
  999.     call close('OwnerName')
  1000.   end
  1001.  
  1002.   if (pos('FINALWRITER', CurrentDir) > 0) | (left(CallHost, 6) == 'FINALW') then do
  1003.     App     = 'FW'
  1004.     AppName = 'FINALWRITER'
  1005.     if CallHost == 'REXX' then HostPort = substr(PortList, pos('FINALW.', PortList), 8)
  1006.     else HostPort = CallHost
  1007.     address value HostPort
  1008.  
  1009.     if owner == 'rgoertz' then do
  1010.       if CallHost == 'REXX' then CLEARDOC FORCE
  1011.       else do
  1012.         CLEARDOC
  1013.         if result == 1 then exit
  1014.       end
  1015.     end
  1016.     else do
  1017.       CLEARDOC
  1018.       if result == 1 then exit
  1019.     end
  1020.  
  1021.     GETDOCITEMPREFS Decimal; DecimalFormat = result
  1022.     DOCITEMPREFS Decimal Period
  1023.   end
  1024.   else if (pos('PAGESTREAM', CurrentDir) > 0) | (CallHost == 'PAGESTREAM') then do
  1025.     App     = 'PGS'
  1026.     AppName = 'PAGESTREAM'
  1027.     HostPort = 'PAGESTREAM'
  1028.   end
  1029.  
  1030.   return HostPort
  1031. /**/
  1032.  
  1033. /***//*******  DoOptions (DO) Subroutine  ***********/
  1034. DoOptions:
  1035.   DO_PrevDay = Day - 7
  1036.  
  1037.   if (DayType == 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Extended
  1038.   else if (DayType == 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Extended
  1039.  
  1040.   /***//* DoJulian & DoJulianLeft */
  1041.   if (DoJulian ~= 0) | (DoJulianLeft ~= 0) then do
  1042.     DO_JDay = right(DateInfo('J', JulianDay, 'I'), 3)
  1043.     if (Day <= 0) & (PrevMonth = 12) then DO_JDayLeft = right(365 + PrevLeapYear - DO_JDay, 3, '0')
  1044.     else DO_JDayLeft = right(365 + LeapYear - DO_JDay, 3, '0')
  1045.  
  1046.     if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Julian
  1047.     else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Julian
  1048.  
  1049.     if DoJulian ~= 0 then do
  1050.       DO_Text2Print = Text.Julian''DO_JDay
  1051.       if DoJulianLeft == DoJulian then DO_Text2Print = DO_Text2Print'/'DO_JDayLeft
  1052.       call UpdateBusy(Req, 1)
  1053.       JID.Day = PrintOption(DoJulian)
  1054.       if (i = 5) & (left(DoJulian, 1) ~= 'T') then call Move(JID.DO_PrevDay, 0, -BoxHeight / 2)
  1055.     end
  1056.  
  1057.     if (DoJulianLeft ~= 0) & (DoJulianLeft ~= DoJulian) then do
  1058.       DO_Text2Print = DO_JDayLeft
  1059.       call UpdateBusy(Req, 1)
  1060.       JIDL.Day = PrintOption(DoJulian)
  1061.       if (i = 5) & (left(DoJulianLeft, 1) ~= 'T') then call Move(JIDL.DO_PrevDay, 0, -BoxHeight / 2)
  1062.     end
  1063.   end
  1064.   /**/
  1065.  
  1066. /***//* DoSunrise & DoSunset */
  1067.   if (DoSunRise ~= 0) | (DoSunSet ~= 0) then do
  1068.     SRSS$ = GetSRSS(JulianDay)
  1069.  
  1070.     if DoSunRise ~= 0 then do
  1071.       if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Sunrise
  1072.       else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Sunrise
  1073.       DO_Text2Print = Text.Sunrise''word(SRSS$, 1)
  1074.       if DoSunSet == DoSunRise then DO_Text2Print = DO_Text2Print'/'word(SRSS$, 3)
  1075.       call UpdateBusy(Req, 1)
  1076.       SRID.Day = PrintOption(DoSunRise)
  1077.       if (i = 5) & (left(DoSunRise, 1) ~= 'T') then call Move(SRID.DO_PrevDay, 0, -BoxHeight / 2)
  1078.     end
  1079.  
  1080.     if (DoSunSet ~= 0) & (DoSunSet ~= DoSunRise) then do
  1081.       if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.Sunset
  1082.       else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.Sunset
  1083.       DO_Text2Print = Text.Sunset''word(SRSS$, 3)
  1084.       call UpdateBusy(Req, 1)
  1085.       SSID.Day = PrintOption(DoSunSet)
  1086.       if (i = 5) & (left(DoSunSet, 1) ~= 'T') then call Move(SSID.DO_PrevDay, 0, -BoxHeight / 2)
  1087.     end
  1088.   end
  1089.   /**/
  1090.  
  1091. /***//* DoWeekNumber */
  1092.   if (DoWeekNumber ~= 0) & (j = 0) then do
  1093.     if (DayType ~= 'Extended') & (BackBox.JulianDay == 0) then DO_PrintColor = Color.WeekNumber
  1094.     else if (DayType ~= 'Extended') & (BackBox.JulianDay ~= 0) then DO_PrintColor = AltColor.WeekNumber
  1095.     DO_WN = trunc(right(DateInfo('J', JulianDay, 'I'), 3)/7, 0) + 1
  1096.     If StartYear == 1 then DO_WN = DO_WN - 1
  1097.     DO_Text2Print = Text.WeekNumber''DO_WN
  1098.     call UpdateBusy(Req, 1)
  1099.     WNID.Day = PrintOption(DoWeekNumber)
  1100.     if (i = 5) & (left(DoWeekNumber, 1) ~= 'T') then call Move(WNID.DO_PrevDay, 0, -BoxHeight / 2)
  1101.   end
  1102.   /**/
  1103.  
  1104.   /***//* DoImages */
  1105.   if DoImages == 1 then do
  1106.     if Image.Month.Day ~= '' then do
  1107.       ImageNumber = Image.Month.Day
  1108.       if ImageSize.ImageNumber == '' then do
  1109.         address command Storage'Visage >'Storage'FWCTemp 'ImageFile.ImageNumber' info'
  1110.         call open('Temp', Storage'FWCTemp')
  1111.           call readln('Temp')
  1112.           DO_InfoLine = strip(readln('Temp'))
  1113.           ImgType.ImageNumber = word(DO_InfoLine, 2)
  1114.           DO_Size = word(DO_InfoLine, 3)
  1115.         call close('Temp')
  1116.         parse var DO_Size DO_Width 'x' DO_Height 'x' .
  1117.         ImageSize.ImageNumber = DO_Width' 'DO_Height
  1118.       end
  1119.  
  1120.       Image.Width  = word(ImageSize.ImageNumber, 1) / 72
  1121.       Image.Height = word(ImageSize.ImageNumber, 2) / 72
  1122.       if (Image.Width > (BoxWidth * MaxImgWidth)) | (Image.Height > (BHeight * MaxImgHeight)) then do
  1123.         EnlFactor = max(Image.Width / (BoxWidth * MaxImgWidth), Image.Height / (BHeight * MaxImgHeight))
  1124.         Image.Width  = Image.Width/EnlFactor
  1125.         Image.Height = Image.Height/EnlFactor
  1126.       end
  1127.       Image.Left = BoxLeft + (BoxWidth - Image.Width)/2
  1128.       Image.Top  = BoxTop + (BHeight - Image.Height)/2
  1129.  
  1130.       call UpdateBusy(Req, 1)
  1131.       if App == 'FW' then do
  1132.         INSERTIMAGE ImageFile.ImageNumber POSITION 1 Image.Left Image.Top Image.Width Image.Height
  1133.         ImageID.Day = result
  1134.         OBJECTTOBACK ImageID.Day
  1135.         if BackBox.JulianDay ~= 0 then OBJECTTOBACK BackBox.JulianDay
  1136.       end
  1137.       else if App == 'PGS' then do
  1138.         DO_ImgType = ImgType.ImageNumber
  1139.         PLACEGRAPHIC FILE ImageFile.ImageNumber FILTER PGSFilter.DO_ImgType AT Image.Left Image.Top WINDOW winName
  1140.         ImageID.Day = result
  1141.         EDITPICTURE POSITION Image.Left Image.Top (Image.Left + Image.Width) (Image.Top + Image.Height) WINDOW winName
  1142.         SENDTOBACK OBJECTID ImageID.Day WINDOW winName
  1143.         if BackBox.JulianDay ~= 0 then SENDTOBACK OBJECTID BackBox.JulianDay WINDOW winName
  1144.       end
  1145.     end
  1146.  
  1147.     if (i = 5) & (Image.Month.DO_PrevDay ~= '') then do
  1148.       ImageNumber = Image.Month.DO_PrevDay
  1149.       Image.Width  = word(ImageSize.ImageNumber, 1)
  1150.       Image.Height = word(ImageSize.ImageNumber, 2)
  1151.       if (Image.Width > (BoxWidth * MaxImgWidth)) | (Image.Height > (BHeight * MaxImgHeight)) then do
  1152.         EnlFactor = max(Image.Width / (BoxWidth * MaxImgWidth), Image.Height / (BHeight * MaxImgHeight))
  1153.         Image.Width  = Image.Width/EnlFactor
  1154.         Image.Height = Image.Height/EnlFactor
  1155.       end
  1156.       Image.Left = BoxLeft + (BoxWidth - Image.Width)/2
  1157.       Image.Top  = BoxTop - BHeight + (BHeight - Image.Height)/2
  1158.  
  1159.       if App == 'FW' then do
  1160.         SETOBJECTCOORDS ImageID.DO_PrevDay 1 Image.Left Image.Top Image.Width Image.Height
  1161.         OBJECTTOBACK ImageID.DO_PrevDay
  1162.       end
  1163.       else if App == 'PGS' then do
  1164.         EDITPICTURE POSITION Image.Left Image.Top (Image.Left + Image.Width) (Image.Top + Image.Height) OBJECTID ImageID.DO_PrevDay WINDOW winName
  1165.         SENDTOBACK OBJECTID ImageID.DO_PrevDay WINDOW winName
  1166.       end
  1167.     end
  1168.   end
  1169.   /**/
  1170.  
  1171. /***//* DoPhases */
  1172.   if Day < 1 then do
  1173.     DO_PrintColor = Color.Extended
  1174.     DO_MoonDay = PrintDay
  1175.     DO_MoonMonth = PrevMonth
  1176.     DO_MoonYear = PrevYear
  1177.   end
  1178.   else if Day > MonthLength.Month then do
  1179.     DO_PrintColor = Color.Extended
  1180.     DO_MoonDay = PrintDay
  1181.     DO_MoonMonth = NextMonth
  1182.     DO_MoonYear = NextYear
  1183.   end
  1184.   else do
  1185.     DO_PrintColor = Color.Moon
  1186.     DO_MoonDay = Day
  1187.     DO_MoonMonth = Month
  1188.     DO_MoonYear = EnteredYear
  1189.   end
  1190.   if (DoPhases ~= 0) & (MoonPhase.DO_MoonYear.DO_MoonMonth.DO_MoonDay ~= '') then do
  1191.     DO_MoonLeft = BoxLeft + BoxWidth / 2
  1192.     if DoPhases == 'L' then DO_MoonLeft = BoxLeft + (MoonRadius * 1.2)
  1193.     else if (DoPhases == 'R') | (DoPhases == 'T') then DO_MoonLeft = BoxLeft + BoxWidth - (MoonRadius * 1.2)
  1194.     if DoPhases == 'T' then DO_DX = MoonRadius * 1.2
  1195.     else DO_DX = BHeight - (MoonRadius * 1.2)
  1196.     MoonID.Day = DrawMoon(MoonPhase.DO_MoonYear.DO_MoonMonth.DO_MoonDay, DO_MoonLeft, BoxTop + DO_DX, DO_PrintColor)
  1197.     if DoPhases == 'T' then MoonID.Day = 0
  1198.     call UpdateBusy(Req, 1)
  1199.   end
  1200.   if (i = 5) & (MoonPhase.EnteredYear.Month.DO_PrevDay ~= '') then call Move(MoonID.DO_PrevDay, 0, -BoxHeight / 2)
  1201.   /**/
  1202.  
  1203.   return
  1204. /**/
  1205.  
  1206. /***//*******  DoSetupReq () Subroutine  ***********/
  1207. DoSetupReq:
  1208.   ActiveJulian   = 0
  1209.   ActiveJulian.  = 0
  1210.   ActiveSunCalc  = 0
  1211.   ActiveSunCalc. = 0
  1212.   Option.        = 0
  1213.  
  1214.   do opt = 1 + (MathLib ~= 1) to 5 + 3 * exists(Storage'suncalc')
  1215.     interpret 'DoValue = Do'Do.opt
  1216.     if (DoValue ~= 0) & (length(DoValue) == 1) then DoValue = 'B'DoValue
  1217.     interpret 'posn = Option.'opt
  1218.     if ((DoValue == 0) | (symbol(DoValue) == 'LIT')) & (posn == 0) then interpret 'Option.'DoValue' = MXPos.'Do.opt
  1219.   end
  1220.  
  1221.   do i = 0 to 4
  1222.     grp = pos.i
  1223.     option = Option.grp
  1224.     if (Do.option == 'Sunset') & (DoSunrise == DoSunset) then interpret 'Option.'pos.i' = 'MXPos.BothS
  1225.     else if (Do.option == 'JulianLeft') & (DoJulian == DoJulianLeft) then interpret 'Option.'pos.i' = 'MXPos.BothJ
  1226.   end
  1227.  
  1228.   call bguilist('monthlist_',January$,February$,March$,April$,May$,June$,July$,August$,September$,October$,November$,December$)
  1229.   call bguilist('mxopts_',None$,Phases$,Weeknumber$,Julian$,JulLeft$,JulJulLeft$,Sunrise$,Sunset$,RiseSet$)
  1230.  
  1231.   call UpdateBusy(Req, 1)
  1232.   g=bguivgroup(,
  1233.     bguimx('mainswitcher_',,bguilist('mainpnames_',OptLayout$,Top$,Bottom$),'T')bguilayout(LGO_FixMinHeight,1)||,
  1234.     bguipages('mainpages_',,
  1235.       bguivgroup(,
  1236.         bguihgroup(,
  1237.           bguivgroup(,
  1238.             bguicheckbox('minicals_',MiniCals$, DoMiniCals)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1239.             bguicheckbox('highlights_',Highlights$, DoHighlights)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1240.             bguicheckbox('extended_',Extended$, DoExtended)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1241.           )||,
  1242.           bguivarspace(10)||,
  1243.           bguivgroup(,
  1244.             bguicheckbox('dateboxes_',BoxDates$, DoDateBox)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1245.             bguicheckbox('backgrounds_',Backgrounds$, DoBackgrounds)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1246.             bguicheckbox('images_',Images$, DoImages)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1247.           ),
  1248.         ,-2,'F','Options')||,
  1249.         bguivgroup(,
  1250.           bguihgroup(,
  1251.             bguivarspace(40)||,
  1252.             bguistring('topmargin_',,Margin.Top,8)bguilayout(LGO_FixMinHeight, 1)bguilayout(LGO_Weight,20)||,
  1253.             bguivarspace(40),
  1254.           )||,
  1255.           bguihgroup(,
  1256.             bguivarspace(20)||,
  1257.             bguistring('leftmargin_',,Margin.Left,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
  1258.             bguicycle('orientation_',,bguilist('orientlist_',Wide$,Tall$))bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
  1259.             bguistring('rightmargin_',,Margin.Right,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
  1260.             bguivarspace(20),
  1261.           )||,
  1262.           bguihgroup(,
  1263.             bguivarspace(40)||,
  1264.             bguistring('bottommargin_',,Margin.Bottom,8)bguilayout(LGO_FixMinHeight, 1,LGO_Weight,20)||,
  1265.             bguivarspace(40),
  1266.           ),
  1267.         ,-2,'F',OrientMarg$)||,
  1268.         bguihgroup(,
  1269.           bguicycle('currentvar_',,'VarName')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  1270.           bguistring('currentvalue_',,value(VarName),256)bguilayout(LGO_FixMinHeight,1),
  1271.         ,-2,'F',MiscVar$),
  1272.       )||,
  1273.       bguihgroup(,
  1274.         bguivarspace(40)||,
  1275.         bguivgroup(,
  1276.           bguimx('topcenter_',Top$||'0a'x||Center$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1277.         ,-3,'F')||,
  1278.         bguivgroup(,
  1279.           bguimx('topright_',Top$||'0a'x||Right$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1280.         ,-3,'F'),
  1281.       )||,
  1282.       bguihgroup(,
  1283.         bguivgroup(,
  1284.           bguimx('bottomleft_',Bottom$||'0a'x||Left$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1285.         ,-3,'F')||,
  1286.         bguivgroup(,
  1287.           bguimx('bottomcenter_',Bottom$||'0a'x||Center$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1288.         ,-3,'F')||,
  1289.         bguivgroup(,
  1290.           bguimx('bottomright_',Bottom$||'0a'x||Right$,'mxopts_','R')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1291.         ,-3,'F'),
  1292.       ),
  1293.     )||,
  1294.     bguihgroup(,
  1295.       bguicycle('monthchoice_',,'monthlist_')bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1296.       bguistring('yearchoice_',,Year,5)bguilayout(LGO_FixMinHeight, 1),
  1297.     )||,
  1298.     bguihgroup(,
  1299.       bguibutton('monthly_',Monthly$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1300.       bguibutton('yearly_',WholeYear$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1301.       bguivarspace(2)||,
  1302.       bguibutton('reset_',Reset$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1)||,
  1303.       bguivarspace(2)||,
  1304.       bguibutton('cancel_',Cancel$)bguilayout(LGO_FixMinWidth, 1,LGO_FixMinHeight, 1),
  1305.     ),
  1306.   ,'-3','-3')
  1307.  
  1308.   call UpdateBusy(Req, 1)
  1309.   winID=bguiwindow(VarGUITitle$,g,0,0,,AppScreen)
  1310.  
  1311.   do i = 0 to GroupCount
  1312.     interpret 'call bguiset('grp.i',winID,MX_Active,Option.'pos.i')'
  1313.     call ControlMX(i)
  1314.     if MathLib ~= 1 then interpret 'call bguiset('grp.i',winID,MX_DisableButton,1)'
  1315.     if ~exists(Storage'suncalc') then interpret 'call bguiset('grp.i',winID,MX_DisableButton,6,MX_DisableButton,7,MX_DisableButton,8)'
  1316.   end
  1317.   call bguiset(obj.orientation_,winID,CYC_Active,OrientChoice)
  1318.   call bguiset(obj.monthchoice_,winID,CYC_Active,CalMonth-1)
  1319.   call bguiset(obj.currentvar_,,BT_Key,'09'x)
  1320.   call bguiset(obj.currentvalue_,,BT_Key,'0d'x)
  1321.   call bguiset(obj.images_,winID,GA_Disabled,~exists(Storage'visage'))
  1322.   call bguiaddmap(obj.mainswitcher_,obj.mainpages_,MX_Active,PAGE_Active)
  1323.   call bguiwintabcycleorder(winID,obj.topmargin_||obj.leftmargin_||obj.rightmargin_||obj.bottommargin_)
  1324.  
  1325.   if bguiwinopen(winID)=0 then bguierror(12)
  1326.  
  1327.   if Req ~= 0 then call bguiwinclose(Req)
  1328.  
  1329.   CalType = 0
  1330.   Reset   = 0
  1331.   do while 1
  1332.     call bguiwinwaitevent(winID,'ID')
  1333.     select
  1334.       when (id == id.cancel_) | (id == id.winclose) then do
  1335.         call bguiwinclose(winID)
  1336.         call Cleanup
  1337.       end
  1338.       when id = id.reset_ then do
  1339.         Reset = 1
  1340.         address command 'delete >NIL: 'ScriptDir''ChangesFile' quiet'
  1341.         leave
  1342.       end
  1343.       when id = id.minicals_ then     DoMiniCals = sign(bguiget(obj.minicals_, GA_Selected))
  1344.       when id = id.highlights_ then   DoHighlights = sign(bguiget(obj.highlights_, GA_Selected))
  1345.       when id = id.extended_ then     DoExtended = sign(bguiget(obj.extended_, GA_Selected))
  1346.       when id = id.dateboxes_ then    DoDateBox = sign(bguiget(obj.dateboxes_, GA_Selected))
  1347.       when id = id.backgrounds_ then  DoBackgrounds = sign(bguiget(obj.backgrounds_, GA_Selected))
  1348.       when id = id.images_ then       DoImages = sign(bguiget(obj.images_, GA_Selected))
  1349.       when id = id.topmargin_ then    Margin.Top = bguiget(obj.topmargin_, STRINGA_TextVal)
  1350.       when id = id.leftmargin_ then   Margin.Left = bguiget(obj.leftmargin_, STRINGA_TextVal)
  1351.       when id = id.rightmargin_ then  Margin.Right = bguiget(obj.rightmargin_, STRINGA_TextVal)
  1352.       when id = id.bottommargin_ then Margin.Bottom = bguiget(obj.bottommargin_, STRINGA_TextVal)
  1353.       when id = id.orientation_ then do
  1354.         if bguiget(obj.orientation_,CYC_Active) == 0 then Orientation = 'Wide'
  1355.         else Orientation = 'Tall'
  1356.       end
  1357.       when id =id.currentvar_ then do
  1358.         Value = bguiget(obj.currentvalue_, STRINGA_TextVal)
  1359.         if datatype(Value) == 'CHAR' then Value = "'"strip(Value,'B', "'"||'"')"'"
  1360.         interpret Varname' = 'Value
  1361.         VarNumber = bguiget(obj.currentvar_, CYC_Active)
  1362.         interpret 'VarName   = VarName.'bguiget(obj.currentvar_, CYC_Active)
  1363.         call bguiset(obj.currentvalue_,winID,STRINGA_TextVal,Value(VarName))
  1364.       end
  1365.       when id == id.monthly_ then do
  1366.         CalType = 1
  1367.         EnteredYear = bguiget(obj.yearchoice_, STRINGA_TextVal)
  1368.         Month = bguiget(obj.monthchoice_, CYC_Active) + 1
  1369.       end
  1370.       when id == id.yearly_ then do
  1371.         CalType = 2
  1372.         EnteredYear = bguiget(obj.yearchoice_, STRINGA_TextVal)
  1373.         leave
  1374.       end
  1375.       when id == id.bottomleft_ then call ControlMX(0)
  1376.       when id == id.bottomcenter_ then call ControlMX(1)
  1377.       when id == id.bottomright_ then call ControlMX(2)
  1378.       when id == id.topcenter_ then call ControlMX(3)
  1379.       when id == id.topright_ then call ControlMX(4)
  1380.       otherwise nop
  1381.     end
  1382.     if CalType ~= 0 then leave
  1383.   end
  1384.   Value = bguiget(obj.currentvalue_, STRINGA_TextVal)
  1385.   if datatype(Value) == 'CHAR' then Value = "'"strip(Value,'B', "'"||'"')"'"
  1386.   interpret Varname' = 'Value
  1387.   return
  1388. /**/
  1389.  
  1390. /***//*******  DrawBox (DB) Subroutine  ***********/
  1391. DrawBox:
  1392.   parse arg DB_x1, DB_y1, DB_width, DB_height, DB_Weight, DB_LineColor, DB_FillBool, DB_FillColor, DB_SendToBack
  1393.  
  1394.   if App == 'FW' then do
  1395.     if DB_Weight == 'HL' then DB_Weight = 'Hairline'
  1396.     else if DB_Weight == 0 then do
  1397.       DB_Weight = 'None'
  1398.       DB_LineColor = DB_FillColor
  1399.     end
  1400.  
  1401.     if DB_FillBool == 1 then DB_FillBool = 'Solid'
  1402.     else do
  1403.       DB_FillBool = 'Transparent'
  1404.       DB_FillColor = DB_LineColor
  1405.     end
  1406.  
  1407.     BOXPREFS LINEWT DB_Weight LINECOLOR '"'DB_LineColor'"' FILL DB_FillBool FILLCOLOR '"'DB_FillColor'"'
  1408.     DRAWBOX 1 DB_x1 DB_y1 DB_width DB_height; DB_id = result
  1409.     if DB_SendToBack == 1 then OBJECTTOBACK
  1410.   end
  1411.   else if App == 'PGS' then do
  1412.     if DB_Weight == 'HL' then DB_Weight = 0.3pt
  1413.     else DB_Weight = DB_Weight'pt'
  1414.  
  1415.     if DB_FillBool == 1 then DB_FillBool = 'ON'
  1416.     else DB_FillBool = 'OFF'
  1417.  
  1418.     If DB_Weight == 0 then DB_LineBool = 'OFF'
  1419.     else DB_LineBool = 'ON'
  1420.  
  1421.     DRAWBOX DB_x1 DB_y1 DB_x1+DB_width DB_y1+DB_height WINDOW winName; DB_id = result
  1422.     STROKED DB_LineBool OBJECT WINDOW winName
  1423.     SETSTROKEWEIGHT DB_Weight STROKENUMBER 0 OBJECT WINDOW winName
  1424.     SETCOLORSTYLE '"'DB_LineColor'"' COLORNUMBER 0 STROKENUMBER 0 OBJECT WINDOW winName
  1425.     FILLED DB_FillBool OBJECT WINDOW winName
  1426.     SETCOLORSTYLE '"'DB_FillColor'"' COLORNUMBER 0 FILL OBJECT WINDOW winName
  1427.     if DB_SendToBack == 1 then SENDTOBACK OBJECTID DB_id WINDOW winName
  1428.   end
  1429.   return DB_id
  1430. /**/
  1431.  
  1432. /***//*******  DrawHalf (DH) Subroutine  ***********/
  1433. DrawHalf:
  1434.   parse arg DH_Side
  1435.  
  1436.   /* DH_FillMode = DM_Phase''DH_Side */
  1437.   if App == 'FW' then do
  1438.     if DH_Side == 'L' then DH_sign = -1
  1439.     else DH_sign = 1
  1440.  
  1441.     STARTPATH 1 DM_CtrX (DM_CtrY + MoonRadius)
  1442.     CURVETO 1 (DM_CtrX + (DH_sign * MoonRadius * BelzierFactor)) (DM_CtrY + MoonRadius) (DM_CtrX + (DH_sign * MoonRadius)) (DM_CtrY + MoonRadius * BelzierFactor) (DM_CtrX + (DH_sign * MoonRadius)) DM_CtrY
  1443.     CURVETO 1 (DM_CtrX + (DH_sign * MoonRadius)) (DM_CtrY - MoonRadius * BelzierFactor) (DM_CtrX + (DH_sign * MoonRadius * BelzierFactor)) (DM_CtrY - MoonRadius) DM_CtrX (DM_CtrY - MoonRadius)
  1444.     ENDPATH Close
  1445.   end
  1446.   else if App == 'PGS' then do
  1447.     if DH_Side == 'L' then DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 90 270 WINDOW winName
  1448.     else DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 270 90 WINDOW winName
  1449.   end
  1450.   return result
  1451. /**/
  1452.  
  1453. /***//*******  DrawLine (DL) Subroutine  ***********/
  1454. DrawLine:
  1455.   parse arg DL_x1, DL_y1, DL_x2, DL_y2, DL_Weight, DL_Color
  1456.   if App == 'FW' then do
  1457.     if DL_Weight == 'HL' then DL_Weight = 'Hairline'
  1458.     else if DL_Weight == 0 then DL_Weight = 'None'
  1459.  
  1460.     LINEPREFS LINEWT DL_Weight LINECOLOR '"'DL_Color'"'
  1461.     DRAWLINE 1 DL_x1 DL_y1 DL_x2 DL_y2
  1462.   end
  1463.   else if App == 'PGS' then do
  1464.     if DL_Weight == 'HL' then DL_Weight = '0.3pt'
  1465.     else DL_Weight = DL_Weight'pt'
  1466.  
  1467.     DRAWLINE DL_x1 DL_y1 DL_x2 DL_y2 WINDOW winName
  1468.     STROKED ON OBJECT WINDOW winName
  1469.     SETSTROKEWEIGHT DL_Weight STROKENUMBER 0 OBJECT
  1470.     SETCOLORSTYLE '"'DL_Color'"' COLORNUMBER 0 STROKENUMBER 0 OBJECT WINDOW winName
  1471.   end
  1472.   return
  1473. /**/
  1474.  
  1475. /***//*******  DrawMiniCal (DMC) Subroutine  ***********/
  1476. DrawMiniCal:
  1477.   parse arg DMC_MiniDirection, DMC_CalWidth, DMC_FontType
  1478.  
  1479.   DMC_ColumnWidth = DMC_CalWidth/8
  1480.   DMC_CenterAdj = (DMC_ColumnWidth - 2*Width.WidthOf8)/2
  1481.   DMC_BoxCount = 0
  1482.  
  1483.   DMC_MiniMonth = Month + DMC_MiniDirection
  1484.   if DMC_MiniMonth == 0 | DMC_MiniMonth == 13 then do
  1485.     DMC_MiniMonth = abs(DMC_MiniMonth - 12)
  1486.     Year = EnteredYear + DMC_MiniDirection
  1487.   end
  1488.   else Year = EnteredYear
  1489.   Mn = right(DMC_MiniMonth, 2, '0')
  1490.   if DoHighlights == 1 then call SetHighlights
  1491.  
  1492.   if DMC_MiniDirection < 0 then do
  1493.     DMC_StartColumn = StartDate - MonthLength.DMC_MiniMonth//7
  1494.     If DMC_StartColumn < 0 then DMC_StartColumn = DMC_StartColumn + 7
  1495.     DMC_MiniCalLeft = Margin.Left + ShiftLMini.App
  1496.   end
  1497.   else if DMC_MiniDirection > 0 then do
  1498.     DMC_StartColumn = StartDate + MonthLength.Month//7
  1499.     If DMC_StartColumn > 6 then DMC_StartColumn = DMC_StartColumn - 7
  1500.     DMC_MiniCalLeft = FullWidth - Margin.Right - DMC_CalWidth + ShiftRMini.App
  1501.   end
  1502.   else do
  1503.     DMC_StartColumn = StartDate
  1504.     DMC_MiniCalLeft = Margin.Left + c * (DMC_CalWidth + MiniCalSpacing)
  1505.   end
  1506.  
  1507.   /* Print Month & Year */
  1508.   DMC_ID.0 = PrintText(1, Margin.Top, DMC_FontType, 'N', Color.MiniCal, Width.DMC_FontType, Month.DMC_MiniMonth' 'Year)
  1509.   call UpdateBusy(Req, 1)
  1510.   if App == 'FW' then do
  1511.     Redraw
  1512.     GetObjectCoords DMC_ID.0; Parse var RESULT . . DMC_Text.Top DMC_Text.Width DMC_Text.Height
  1513.     DMC_Text.Left = DMC_MiniCalLeft + (DMC_CalWidth - DMC_Text.Width)/2
  1514.     SetObjectCoords DMC_ID.0 1 DMC_Text.Left DMC_Text.Top DMC_Text.Width DMC_Text.Height
  1515.   end
  1516.   else if App == 'PGS' then do
  1517.     GETTEXTOBJ POSITION DMC_Text OBJECTID DMC_ID.0 WINDOW winName
  1518.     DMC_Text.Height = DMC_Text.Bottom - DMC_Text.Top
  1519.     DMC_Text.Width = DMC_Text.Right - DMC_Text.Left
  1520.     DMC_Text.Left = DMC_MiniCalLeft + (DMC_CalWidth - DMC_Text.Width)/2
  1521.     EDITTEXTOBJ POSITION DMC_Text.Left DMC_Text.Top (DMC_Text.Left + DMC_Text.Width) DMC_Text.Bottom OBJECTID DMC_ID.0 WINDOW winName
  1522.   end
  1523.  
  1524.   /* Print Days */
  1525.   DMC_Column = DMC_StartColumn
  1526.   DMC_Day = 0
  1527.   DMC_Row = 1
  1528.  
  1529.   Do Until DMC_Day = MonthLength.DMC_MiniMonth
  1530.     DMC_Day = DMC_Day + 1
  1531.  
  1532.     if Highlight.DMC_MiniMonth.DMC_Day == '' then DMC_Style = 'N'
  1533.     else DMC_Style = 'B'
  1534.  
  1535.     DMC_Text.Right = (DMC_Column + 1.5) * DMC_ColumnWidth
  1536.     DMC_Text.Top   = Margin.Top + DMC_Row*DMC_Text.Height
  1537.  
  1538.     Select
  1539.       when DMC_Day < 10 then DMC_Text.Adj = Width.WidthOf8
  1540.       when DMC_Day < 20 then DMC_Text.Adj = Width.WidthOf1 + Width.WidthOf8
  1541.       otherwise DMC_Text.Adj = 2 * Width.WidthOf8
  1542.     end
  1543.     DMC_Text.Left = DMC_MiniCalLeft + DMC_Text.Right - DMC_Text.Adj - DMC_CenterAdj
  1544.     DMC_ID.DMC_Day = PrintText(DMC_Text.Left, DMC_Text.Top, DMC_FontType, DMC_Style, Color.MiniCal, Width.DMC_FontType, DMC_Day)
  1545.     call UpdateBusy(Req, 1)
  1546.  
  1547.     if pos('#', Highlight.DMC_MiniMonth.DMC_Day) > 0 then do
  1548.       DMC_BoxCount = DMC_BoxCount + 1
  1549.       DMC_Box.Left = DMC_MiniCalLeft + (DMC_Column + .5) * DMC_ColumnWidth
  1550.       DMC_BoxID.DMC_BoxCount = DrawBox(DMC_Box.Left, DMC_Text.Top, DMC_ColumnWidth, DMC_Text.Height, 'HL', Line.MiniCal, 0, Black$, 1)
  1551.       if App == 'FW' then OBJECTTOBACK
  1552.       else if App == 'PGS' then SENDTOBACK OBJECTID DMC_BoxID.DMC_BoxCount WINDOW winName
  1553.     end
  1554.  
  1555.     DMC_Column = DMC_Column + 1
  1556.     if DMC_Column == 7 then do
  1557.       DMC_Column = 0
  1558.       DMC_Row = DMC_Row + 1
  1559.     end
  1560.   end
  1561.  
  1562.   call DrawBox(DMC_MiniCalLeft, Margin.Top, DMC_CalWidth, 7*DMC_Text.Height, 'HL', Line.MiniCal, 1, Background.MiniCal, 1)
  1563.   call UpdateBusy(Req, 1)
  1564.  
  1565.   if App == 'FW' then do
  1566.     REDRAW
  1567.     do DMC_i = 0 to MonthLength.DMC_MiniMonth; SELECTOBJECT DMC_ID.DMC_i MULTIPLE; End
  1568.     do DMC_i = 1 to DMC_BoxCount; SELECTOBJECT DMC_BoxID.DMC_i MULTIPLE; End
  1569.     GROUP
  1570.   end
  1571.   if App == 'PGS' then do
  1572.     do DMC_i = 0 to MonthLength.DMC_MiniMonth; SELECTOBJECT ObjectID DMC_ID.DMC_i Add WINDOW winName; End
  1573.     do DMC_i = 1 to DMC_BoxCount; SELECTOBJECT ObjectID DMC_BoxID.DMC_i Add WINDOW winName; End
  1574.     GROUP WINDOW winName
  1575.   end
  1576. return
  1577. /**/
  1578.  
  1579. /***//*******  DrawMoon (DM) Subroutine  ***********/
  1580. DrawMoon:
  1581.   parse arg DM_Phase, DM_CtrX, DM_CtrY, DM_Color
  1582.  
  1583.   if App == 'FW' then do
  1584.     if (DM_Phase == 'N') | (DM_Phase == 'F') then do
  1585.       if DM_Phase == 'N' then DM_FillColor = DM_Color
  1586.       else DM_FillColor = White$
  1587.       OVALPREFS LINEWT 'Hairline' LINECOLOR '"'DM_Color'"' FILL 'Solid' FILLCOLOR '"'DM_FillColor'"'
  1588.       DRAWOVAL 1 (DM_CtrX - MoonRadius) (DM_CtrY - MoonRadius) (2 * MoonRadius) (2 * MoonRadius)
  1589.       DM_id = result
  1590.     end
  1591.     else do
  1592.       SHAPEPREFS LINEWT 'Hairline' LINECOLOR '"'DM_Color'"' FILL 'Solid' FILLCOLOR '"'DM_Color'"'
  1593.       if DM_Phase == 1 then DM_HalfID = DrawHalf('R')
  1594.       else DM_HalfID = DrawHalf('L')
  1595.       SHAPEPREFS FILLCOLOR '"'White$'"'
  1596.       if DM_Phase == 1 then DM_Half2ID = DrawHalf('L')
  1597.       else DM_Half2ID = DrawHalf('R')
  1598.       SELECTOBJECT DM_HalfID
  1599.       SELECTOBJECT DM_Half2ID Multiple
  1600.       GROUP
  1601.       CURRENTOBJECT; DM_id = result
  1602.     end
  1603.   end
  1604.   else if App == 'PGS' then do
  1605.     if (DM_Phase == 'N') | (DM_Phase == 'F') then do
  1606.       DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius WINDOW winName
  1607.       DM_id = result
  1608.       if DM_Phase == 'N' then call SetFill(DM_id, DM_Color, DM_Color)
  1609.       else call SetFill(DM_id, DM_Color, White$)
  1610.     end
  1611.     else do
  1612.       DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 90 270 WINDOW winName
  1613.       DM_LHalfID = result
  1614.       if DM_Phase == 1 then call SetFill(DM_LHalfID, DM_Color, White$)
  1615.       else call SetFill(DM_LHalfID, DM_Color, DM_Color)
  1616.       DRAWELLIPSE DM_CtrX DM_CtrY MoonRadius MoonRadius PIE ANGLES 270 90 WINDOW winName
  1617.       DM_RHalfID = result
  1618.       if DM_Phase == 1 then call SetFill(DM_RHalfID, DM_Color, DM_Color)
  1619.       else call SetFill(DM_RHalfID, DM_Color, White$)
  1620.       SELECTOBJECT OBJECTID DM_LHalfID Add WINDOW winName
  1621.       GROUP WINDOW winName; DM_id = result
  1622.     end
  1623.   end
  1624.  
  1625.   return DM_id
  1626. /**/
  1627.  
  1628. /***//*******  GetFontWidth (GFW) Subroutine  *********/
  1629. GetFontWidth:
  1630.   parse arg GFW_FontType, GFW_Char
  1631.  
  1632.   GFW_ID = PrintText(1, 1, GFW_FontType, 'N', Color.White, Width.GFW_FontType, GFW_Char)
  1633.   if App == 'FW' then do
  1634.     REDRAW
  1635.     GETOBJECTCOORDS GFW_ID; parse var RESULT . . . GFW_Width .
  1636.     DELETEOBJECT GFW_ID
  1637.   end
  1638.   else if App == 'PGS' then do
  1639.     GETTEXTOBJ POSITION GFW_Text OBJECTID GFW_ID WINDOW winName
  1640.     GFW_Width = GFW_Text.Right - GFW_Text.Left
  1641.     DELETEOBJECT OBJECTID GFW_ID WINDOW winName
  1642.   end
  1643. return GFW_Width
  1644. /**/
  1645.  
  1646. /***//*******  GetHeight (GH) Subroutine  ***********/
  1647. GetHeight:
  1648.   parse arg GH_FontType
  1649.  
  1650.   if App == 'FW' then do
  1651.     TEXTBLOCKTYPEPREFS SIZE FSize.GH_FontType FONT Font.GH_FontType
  1652.     DRAWTEXTBLOCK 1 1 1 'A'; GH_id = result
  1653.     GETOBJECTCOORDS GH_id; Parse Var result . . . . GH_Text.Height
  1654.     DELETEOBJECT GH_id
  1655.   end
  1656.   else if App == 'PGS' then do
  1657.     DRAWTEXTOBJ 0 0 WINDOW winName; GH_id = result
  1658.     SELECTTEXT AT 0 0 WINDOW winName
  1659.     BEGINCOMMANDCAPTURE
  1660.       SETTYPESIZE FSize.GH_FontType WINDOW winName
  1661.       SETFONT Font.GH_FontType WINDOW winName
  1662.     ENDCOMMANDCAPTURE
  1663.     INSERT 'A' WINDOW winName
  1664.     GETTEXTOBJ POSITION GH_Text OBJECTID GH_id WINDOW winName
  1665.     GH_Text.Height = GH_Text.Bottom - GH_Text.Top
  1666.     DELETEOBJECT OBJECTID GH_id WINDOW winName
  1667.   end
  1668.   return GH_Text.Height
  1669. /**/
  1670.  
  1671. /***//*******  GetLogInfo () Subroutine  ***********/
  1672. GetLogInfo:
  1673.   if ~exists(Storage'FWC'App'Temp.txt') then address command 'list >'Storage'FWC'App'Temp.txt 'AppName'#? lformat %N'
  1674.   if open('Temp', Storage'FWC'App'Temp.txt') ~= 0 then do
  1675.     do while ~eof('Temp')
  1676.       PgmName = readln('Temp')
  1677.       if pos('.', PgmName) == 0 then leave
  1678.     end
  1679.     call close('Temp')
  1680.   end
  1681.  
  1682.   if ~exists(Storage'FWC'App'VersionInfo.txt') then address command 'version >'Storage'FWC'App'VersionInfo.txt 'PgmName
  1683.  
  1684.   call open('Temp', Storage'FWC'App'VersionInfo.txt')
  1685.     PgmVersion = readln('Temp')
  1686.   call close('Temp')
  1687.  
  1688.   if left(PgmVersion, 34) == 'Could not find version information' then do
  1689.     if App == 'FW' then do
  1690.       call open('Temp', CurrentDir''PgmName)
  1691.         /* Desired string at 325365 for v 5.06 */
  1692.         /* Desired string at 333771 for FW97   */
  1693.         FileOffset = 325300
  1694.         call seek('Temp', FileOffset, 'B')
  1695.         do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  1696.           PrevOffset = FileOffset
  1697.           Chunk = readch('Temp', 10000)
  1698.           EndPos = pos('Created', Chunk)
  1699.           if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
  1700.         end
  1701.         if EndPos == 0 then PgmVersion = 'Final Writer - version unknown'
  1702.         else do
  1703.           StartPos = lastpos('Final', Chunk, EndPos)
  1704.           EndPos = pos('00'x||'00'x, Chunk, StartPos)
  1705.           PgmVersion = substr(Chunk, StartPos, EndPos - StartPos - 1)
  1706.         end
  1707.       call close('Temp')
  1708.       call open('Temp', Storage'FWC'App'VersionInfo.txt', 'W')
  1709.         call writeln('Temp', PgmVersion)
  1710.       call close('Temp')
  1711.     end
  1712.     else PgmVersion = PgmName" - can't find version info"
  1713.   end
  1714.  
  1715.   return
  1716. /**/
  1717.  
  1718. /***//*******  GetMaxWidth (GMW) Subroutine  ***********/
  1719. GetMaxWidth:
  1720.   parse arg GMW_Stem, GMW_Count
  1721.  
  1722.   GMW_maxwidth = 0
  1723.   Do GMW_i = 0 to GMW_Count
  1724.     interpret 'GMW_ObjectID = 'GMW_Stem'.'GMW_i
  1725.     if App = 'FW' then do
  1726.       GETOBJECTCOORDS GMW_ObjectID
  1727.       Parse Var result . . . GMW_width .
  1728.     end
  1729.     else if App == 'PGS' then do
  1730.       SELECTOBJECT ObjectID GMW_ObjectID WINDOW winName
  1731.       GETTEXTOBJ POSITION GMW_Temp OBJECTID GMW_ObjectID WINDOW winName
  1732.       GMW_width = GMW_Temp.Right - GMW_Temp.Left
  1733.     end
  1734.     GMW_maxwidth = max(GMW_width, GMW_maxwidth)
  1735.   end
  1736.  
  1737.   return GMW_maxwidth
  1738. /**/
  1739.  
  1740. /***//*******  GetPhases (GP) Subroutine  ***********/
  1741. /* Routine to determine the dates of the new and full moons for a given year */
  1742. /* obtained from the Sky & Telescope web site. The basic program from which  */
  1743. /* the following was derived originally appeared in Astronomical Computing,  */
  1744. /* Sky & Telescope, March, 1985                                              */
  1745. GetPhases:
  1746.  
  1747.   parse arg GP_Y
  1748.  
  1749.   GP_Progress = -2
  1750.   GP_R1 = PI(0) / 180
  1751.   GP_NextPhase = 29.530588853 / 4
  1752.   GP_U  = 0
  1753.  
  1754.   GP_K0 = trunc((GP_Y - 1900) * 12.3685)
  1755.   GP_T  = (GP_Y - 1899.5) / 100
  1756.   GP_T2 = GP_T*GP_T
  1757.   GP_T3 = GP_T*GP_T*GP_T
  1758.   GP_J0 = 2415020 + 29 * GP_K0
  1759.   GP_F0 = 0.0001178 * GP_T2 - 0.000000155 * GP_T3 + 0.75933 + 0.53058868 * GP_K0 - 0.000837 * GP_T - 0.000335 * GP_T2
  1760.  
  1761.   GP_J0  = GP_J0 + trunc(GP_F0)
  1762.   GP_F0  = GP_F0 - trunc(GP_F0)
  1763.  
  1764.   GP_M0 = GP_K0 * 0.08084821133
  1765.   GP_M0 = 360 * (GP_M0 - trunc(GP_M0)) + 359.2242 - 0.0000333 * GP_T2 - 0.00000347 * GP_T3
  1766.   GP_M1 = GP_K0 * 0.07171366128
  1767.   GP_M1 = 360 * (GP_M1 - trunc(GP_M1)) + 306.0253 + 0.0107306 * GP_T2 + 0.00001236 * GP_T3
  1768.   GP_B1 = GP_K0 * 0.08519585128
  1769.   GP_B1 = 360 * (GP_B1 - trunc(GP_B1)) + 21.2964 - 0.0016528 * GP_T2 - 0.00000239 * GP_T3
  1770.   do GP_K9 = 0 to 28
  1771.     if GP_K9//4 == 0 then do
  1772.       GP_Progress = -GP_Progress
  1773.       call UpdateBusy(Req, GP_Progress)
  1774.     end
  1775.     GP_J  = GP_J0 + 14 * GP_K9
  1776.     GP_F  = GP_F0 + 0.765294 * GP_K9
  1777.     GP_K  = GP_K9 / 2
  1778.     GP_M5 = (GP_M0 + GP_K * 29.10535608) * GP_R1
  1779.     GP_M6 = (GP_M1 + GP_K * 385.81691806) * GP_R1
  1780.     GP_B6 = (GP_B1 + GP_K * 390.67050646) * GP_R1
  1781.     GP_F  = GP_F - 0.4068 * SIN(GP_M6) + (0.1734 - 0.000393 * GP_T) * SIN(GP_M5) + 0.0161 * SIN(2 * GP_M6)
  1782.     GP_F  = GP_F + 0.0104 * SIN(2 * GP_B6) - 0.0074 * SIN(GP_M5 - GP_M6) - 0.0051 * SIN(GP_M5 + GP_M6)
  1783.     GP_F  = GP_F + 0.0021 * SIN(2 * GP_M5) + 0.0010 * SIN(2 * GP_B6 - GP_M6)
  1784.     GP_J  = GP_J + trunc(GP_F)
  1785.     GP_F  = GP_F - trunc(GP_F)
  1786.  
  1787.     GP_Converted  = ConvertJ(GP_F, GP_J)
  1788.     GP_Y          = word(GP_Converted, 1) - 0
  1789.     GP_M          = word(GP_Converted, 2) - 0
  1790.     GP_Day        = word(GP_Converted, 3) - 0
  1791.     GP_Hrs        = word(GP_Converted, 4)
  1792.     if GP_U = 0 then do
  1793.       MoonPhase.GP_Y.GP_M.GP_Day = 'N'
  1794.       GP_FQ = DateInfo('S', trunc(DateInfo('I', GP_Y''right(GP_M, 2, '0')''right(GP_Day, 2, '0'), 'S') + GP_Hrs + GP_NextPhase))
  1795.       GP_Y = left(GP_FQ, 4)
  1796.       GP_M = strip(substr(GP_FQ, 5, 2), 'L', '0')
  1797.       GP_Day = strip(right(GP_FQ, 2), 'L', '0')
  1798.       MoonPhase.GP_Y.GP_M.GP_Day = '1'
  1799.     end
  1800.     if GP_U = 1 then do
  1801.       MoonPhase.GP_Y.GP_M.GP_Day = 'F'
  1802.       GP_TQ = DateInfo('S', trunc(DateInfo('I', GP_Y''right(GP_M, 2, '0')''right(GP_Day, 2, '0'), 'S') + GP_Hrs + GP_NextPhase))
  1803.       GP_Y = left(GP_TQ, 4)
  1804.       GP_M = strip(substr(GP_TQ, 5, 2), 'L', '0')
  1805.       GP_Day = strip(right(GP_TQ, 2), 'L', '0')
  1806.       MoonPhase.GP_Y.GP_M.GP_Day = '3'
  1807.     end
  1808.     GP_U = GP_U + 1
  1809.     if GP_U = 2 then GP_U = 0
  1810.   end
  1811.   if sign(GP_Progress) == 1 then call UpdateBusy(Req, -GP_Progress)
  1812. return 0
  1813. /**/
  1814.  
  1815. /***//*******  GetSetupInfo () Subroutine  ***********/
  1816. GetSetupInfo:
  1817.   Year = left(date('S'),4)
  1818.   ThisMonth = left(date('U'), 2) + 0
  1819.  
  1820.   if (owner == 'rgoertz') & (CallHost == 'REXX') then CalMonth = ThisMonth
  1821.   else if RexxTricks == 1 then do
  1822.     CalMonth = getenv('CalMonth')
  1823.     if CalMonth == '' then CalMonth = ThisMonth
  1824.     else do
  1825.       CalMonth = CalMonth + 1
  1826.       if CalMonth = 13 then CalMonth = 1
  1827.     end
  1828.     CalYear = getenv('CalYear')
  1829.     if (CalYear ~= '') & (DataType(CalYear) == 'NUM') then Year = CalYear
  1830.   end
  1831.   else CalMonth = ThisMonth
  1832.  
  1833.   do until Reset == 0
  1834.     Req = OpenBusy(PrepReq$'...', 6)
  1835.     call CreateDataFile
  1836.     call ReadData
  1837.     call DoSetupReq
  1838.     if Reset == 1 then call bguiwinclose(winID)
  1839.   end
  1840.  
  1841.   do i = 1 to 8
  1842.     if (Do.i='BothJ') | (Do.i='BothS') then iterate
  1843.     interpret 'Do'Do.i' = 0'
  1844.   end
  1845.  
  1846.   do i = 0 to GroupCount
  1847.     pos = pos.i
  1848.     option = option.pos
  1849.     if Do.option == 'BothJ' then do
  1850.       DoJulian = pos.i
  1851.       DoJulianLeft = pos.i
  1852.     end
  1853.     else if Do.option == 'BothS' then do
  1854.       DoSunrise = pos.i
  1855.       DoSunset  = pos.i
  1856.     end
  1857.     else interpret 'Do'Do.option" = '"pos.i"'"
  1858.   end
  1859.  
  1860.   TopOption = 0
  1861.   do i = 1 to 8
  1862.     if (Do.i='BothJ') | (Do.i='BothS') then iterate
  1863.     if left(value('Do'Do.i), 1) == 'T' then do
  1864.       TopOption = 1
  1865.       leave
  1866.     end
  1867.   end
  1868.  
  1869.   call WriteData
  1870.  
  1871.   if CalType == 1 then Calendar = Month.Month' 'EnteredYear
  1872.   else Calendar = EnteredYear
  1873.   call bguiwinclose(winID)
  1874.  
  1875.   Mn = right(Month, 2, '0')
  1876.   if (RexxTricks == 1) & (DataType(Month) == 'NUM') then call setenv('CalMonth', Month)
  1877.   if (RexxTricks == 1) & (DataType(EnteredYear) == 'NUM') then call setenv('CalYear', EnteredYear)
  1878.  
  1879.   return
  1880. /**/
  1881.  
  1882. /***//*******  GetSRSS (GS) Subroutine  ***********/
  1883. GetSRSS:
  1884.   parse arg GS_IDay
  1885.  
  1886.   GS_EDay = translate(DateInfo('E', GS_IDay, 'I'), '-', '/')
  1887.   if RexxTricks == 1 & AdjustDST ~= 0 then do
  1888.     if GS_IDay < StartDST | GS_IDay >= EndDST then call setenv('suncalc/dst', 0)
  1889.     else call setenv('suncalc/dst', 1)
  1890.   end
  1891.   address command Storage'suncalc > 'Storage'SRSS.txt date='GS_EDay' text="$SR $SS"'
  1892.   call open('SRSS', Storage'SRSS.txt')
  1893.     GS_SRSS = readln('SRSS')
  1894.   call close('SRSS')
  1895. return GS_SRSS
  1896. /**/
  1897.  
  1898. /***//*******  GetWidth (GW) Subroutine  ***********/
  1899. GetWidth:
  1900.   parse arg GW_ID
  1901.   if App = 'FW' then do
  1902.     GETOBJECTCOORDS GW_ID
  1903.     Parse Var result . . . GW_width .
  1904.   end
  1905.   else if App == 'PGS' then do
  1906.     SELECTOBJECT OBJECTID GW_ID WINDOW winName
  1907.     GETTEXTOBJ POSITION GW_Temp OBJECTID GW_ID WINDOW winName
  1908.     GW_width = GW_Temp.Right - GW_Temp.Left
  1909.   end
  1910.   return GW_width
  1911. /**/
  1912.  
  1913. /***//*******  HalveBox (HB) Subroutine  ***********/
  1914. HalveBox:
  1915.   parse arg HB_ID
  1916.  
  1917.   if App = 'FW' then do
  1918.     GETOBJECTCOORDS HB_ID
  1919.     parse var result . HB_Left HB_Top HB_Width HB_Height
  1920.     SETOBJECTCOORDS HB_ID 1 HB_Left HB_Top HB_Width HB_Height/2
  1921.   end
  1922.   else if App == 'PGS' then do
  1923.     GETBOX POSITION HB_Coords OBJECTID HB_ID WINDOW winName
  1924.     HB_Bottom = HB_Coords.Top + (HB_Coords.Bottom - HB_Coords.Top) / 2
  1925.     EDITBOX POSITION HB_Coords.Left HB_Coords.Top HB_Coords.Right HB_Bottom OBJECTID HB_ID WINDOW winName
  1926.   end
  1927.  
  1928.   return HB_ID
  1929. /**/
  1930.  
  1931. /***//*******  MiniCalPreCalc (MCPC) Subroutine  *********/
  1932. MiniCalPreCalc:
  1933.   parse arg MCPC_FontType, MCPC_CalWidth
  1934.  
  1935.   Width.MCPC_FontType = 100 * min(1, MCPC_CalWidth/(22*Width.WidthOf8))
  1936.   if App == 'FW' then Width.MCPC_FontType = trunc(Width.MCPC_FontType)
  1937.  
  1938.   Width.WidthOf8 = Width.WidthOf8*Width.MCPC_FontType/100
  1939.   Width.WidthOf1 = Width.WidthOf1*Width.MCPC_FontType/100
  1940. return
  1941. /**/
  1942.  
  1943. /***//*******  Move (M) Subroutine  ***********/
  1944. Move:
  1945.   parse arg M_ID, M_dX, M_dY
  1946.  
  1947.   if M_ID == 0 then return
  1948.   if App = 'FW' then do
  1949.     GETOBJECTCOORDS M_ID; Parse Var result . M_Coords.Left M_Coords.Top M_Coords.Width M_Coords.Height
  1950.     SETOBJECTCOORDS M_ID 1 (M_Coords.Left + M_dX) (M_Coords.Top + M_dY) M_Coords.Width M_Coords.Height
  1951.   end
  1952.   else if App == 'PGS' then MOVE OFFSET M_dX M_dY OBJECTID M_ID WINDOW winName
  1953.  
  1954.   return
  1955. /**/
  1956.  
  1957. /***//*******  NameOnly (NO) Subroutine  ***********/
  1958. NameOnly:
  1959.   parse arg NO_fontname
  1960.   return substr(NO_fontname, max(lastpos(':', NO_fontname), lastpos('/', NO_fontname)) + 1)
  1961. /**/
  1962.  
  1963. /***//*******  OpenBusy (OB) Subroutine  ***********/
  1964. OpenBusy:
  1965.   parse arg OB_BusyTitle, OB_EventCount
  1966.  
  1967.   Progress = 0
  1968.   OB_ProgressGroup=bguivgroup(,
  1969.         bguiinfo('OB_dummy',,'1B'x||'c'OB_BusyTitle)bguilayout(LGO_FixMinHeight,1)||,
  1970.         bguiprogress('OB_prog2_',,0,OB_EventCount)||,
  1971.         bguihgroup(,
  1972.                 bguivarspace(50)bguilayout(LGO_FixMinHeight,1)||,
  1973.                 bguibutton('OB_cancel_',Cancel$)bguilayout(LGO_FixMinHeight,1)||,
  1974.                 bguivarspace(50)bguilayout(LGO_FixMinHeight,1),
  1975.         ,,,,'W'),
  1976.   ,-2,-2)
  1977.  
  1978.   OB_ProgressWindow = bguiwindow(PleaseWait$'...',OB_ProgressGroup,,2,,AppScreen)
  1979.   if bguiwinopen(OB_ProgressWindow) = 0 then call Cleanup
  1980.  
  1981. return OB_ProgressWindow
  1982. /**/
  1983.  
  1984. /***//*******  ParseVariables (PV) Subroutine  ***********/
  1985. ParseVariables:
  1986. parse arg PV_Line
  1987.  
  1988. PV_String = translate(PV_Line,,'=(+-*/,)"'||"'",' ')
  1989. PV_VarString = ''
  1990. PV_Var.      = '00'x
  1991. PV_LongVar   = 4
  1992. PV_LIT       = ''
  1993. PV_Count     = 0
  1994.  
  1995. do PV_i = 1 to words(PV_String)
  1996.   PV_Word = word(PV_String, PV_i)
  1997.   if pos(PV_Word'(', PV_Line) > 0 then iterate
  1998.   if datatype(PV_Word) == 'CHAR' then do
  1999.     if symbol(PV_Word) == 'LIT' then PV_LIT = PV_LIT''PV_Word', '
  2000.     if symbol(PV_Word) == 'VAR' then do
  2001.       PV_LongVar = max(PV_LongVar, length(PV_Word) + 2)
  2002.       if PV_Var.PV_Word == '00'x then do
  2003.         PV_Count = PV_Count + 1
  2004.         PV_Var.PV_Count = PV_Word
  2005.         PV_Var.PV_Word  = value(PV_Word)
  2006.       end
  2007.       if pos('.', PV_Word) > 0 then do
  2008.         PV_CompoundParts = subword(translate(PV_Word,,'.', ' '), 2)
  2009.         do PV_j = 1 to words(PV_CompoundParts)
  2010.           PV_Subword = word(PV_CompoundParts, PV_j)
  2011.           if PV_Var.PV_SubWord == '00'x then do
  2012.             PV_Count = PV_Count + 1
  2013.             PV_Var.PV_Count = PV_SubWord
  2014.             if symbol(PV_Subword) == 'LIT' then PV_Var.PV_SubWord  = 'LIT'
  2015.             else PV_Var.PV_SubWord  = value(PV_SubWord)
  2016.           end
  2017.         end
  2018.       end
  2019.     end
  2020.   end
  2021. end
  2022.  
  2023. do PV_i = 1 to PV_Count
  2024.   PV_Word = PV_Var.PV_i
  2025.   if length(PV_Var.PV_Word) > 50 then PV_Var.PV_Word = left(PV_Var.PV_Word, 50)'...'
  2026.   PV_Var.PV_Word = translate(PV_Var.PV_Word,,'0a'x||'0d'x||'00'x,'bb'x)
  2027.   PV_VarString = PV_VarString''right(PV_Word, PV_LongVar)' = 'PV_Var.PV_Word||'0a'x
  2028. end
  2029.  
  2030. if PV_LIT ~= '' then PV_VarString = right('LIT', PV_LongVar)' = 'strip(PV_LIT, 'B', ' ,')||'0a'x||PV_VarString
  2031. return PV_VarString
  2032. /**/
  2033.  
  2034. /***//*******  PathPart (PP) Subroutine  ***********/
  2035. PathPart:
  2036.   parse arg PP_FileWithPath
  2037.   return left(PP_FileWithPath, max(lastpos(':', PP_FileWithPath), lastpos('/', PP_FileWithPath)))
  2038. /**/
  2039.  
  2040. /***//*******  PrintHighlight (PH) Subroutine  ***********/
  2041. PrintHighlight:
  2042.   parse arg PH_Event
  2043.   /* Fit line(s) into allowable space */
  2044.   PH_AllowedWidth     = BoxWidth - DateOffset - HighlightOffset
  2045.   PH_Textline         = 0
  2046.   PH_Text.            = ''
  2047.   PH_Text.PH_Textline = PH_Event
  2048.  
  2049.   Do until PH_Text.PH_Nextline == ''
  2050.     PH_Nextline = PH_Textline + 1
  2051.     if PH_Textline == 0 then PH_Indent.PH_Textline = 0
  2052.     else PH_Indent.PH_Textline = Width.WidthOfDate1
  2053.  
  2054.     if PH_Event == '' then do
  2055.       PH_Text.PH_TextLine = ''
  2056.       iterate
  2057.     end
  2058.     if App == 'FW' & length(PH_Text.PH_Textline) > 37 then do
  2059.       PH_Wordbreak = lastpos(' ', PH_Text.PH_Textline, 37)
  2060.       PH_Text.PH_Nextline = strip(substr(PH_Text.PH_Textline, PH_Wordbreak)' 'PH_Text.PH_Nextline)
  2061.       PH_Text.PH_Textline = strip(left(PH_Text.PH_Textline, PH_Wordbreak))
  2062.     end
  2063.     PH_ID = PrintText(1, 1, Highlight, 'N', Color.Highlight, Width.Highlight, PH_Text.PH_Textline)
  2064.     if App == 'FW' then redraw
  2065.     PH_TextWidth.PH_Textline = GetWidth(PH_ID)
  2066.     if App == 'FW' then DELETEOBJECT PH_ID
  2067.     else if App == 'PGS' then do
  2068.       SELECTOBJECT ObjectID PH_ID WINDOW winName
  2069.       DELETEOBJECT ObjectID PH_ID WINDOW winName
  2070.     end
  2071.  
  2072.     PH_Width.PH_Textline = PH_TextWidth.PH_Textline + PH_Indent.PH_Textline
  2073.     if (PH_Width.PH_Textline >= PH_AllowedWidth) & (Words(PH_Text.PH_Textline) > 1) then do
  2074.       /* Move last word to next line */
  2075.       PH_Wordbreak     = lastpos(' ', PH_Text.PH_Textline)
  2076.       PH_Text.PH_Nextline = strip(substr(PH_Text.PH_Textline, PH_Wordbreak)' 'PH_Text.PH_Nextline)
  2077.       PH_Text.PH_Textline = strip(left(PH_Text.PH_Textline, PH_Wordbreak))
  2078.     end
  2079.     else if PH_Text.PH_Nextline ~= '' then PH_Textline = PH_Textline + 1
  2080.  
  2081.   end
  2082.   PH_LineCount = PH_Textline
  2083.  
  2084.   do PH_TextLine = 0 to PH_LineCount
  2085.     if PH_Text.PH_TextLine ~= '' then do
  2086.       if App == 'FW' then TextBase = TextAdj
  2087.       else TextBase = 1
  2088.       TextLeft = BoxLeft + DateOffset + HighlightOffset * (DailyHLCount * Height.Highlight < Height.Date * TextBase)
  2089.       PH_TextTop = BoxTop + DailyHLCount * Height.Highlight
  2090.       PH_Width.PH_Textline = min(Width.Highlight, Width.Highlight * PH_AllowedWidth / PH_Width.PH_Textline - 2)
  2091.       if App == 'FW' then PH_Width.PH_Textline = min(max(trunc(PH_Width.PH_Textline), 4), 255)
  2092.       call PrintText(TextLeft + PH_Indent.PH_TextLine, PH_TextTop, Highlight, 'N', TextColor, PH_Width.PH_Textline, PH_Text.PH_TextLine)
  2093.     end
  2094.     if PH_TextLine ~= PH_LineCount then DailyHLCount = DailyHLCount + 1
  2095.   end
  2096.   return
  2097. /**/
  2098.  
  2099. /***//*******  PrintOption (PO) Subroutine  ***********/
  2100. PrintOption:
  2101.   parse arg PO_Location
  2102.  
  2103.   PO_ID = PrintText(BoxLeft + DateOffset, BoxTop + (BHeight - Height.Highlight) * (left(PO_Location, 1) ~= 'T'), Highlight, 'N', DO_PrintColor, Width.Highlight, DO_Text2Print)
  2104.   if right(PO_Location, 1) == 'C' then call CenterText(PO_ID, BoxLeft + BoxWidth / 2, 0, min(1, BoxWidth/GetWidth(PO_ID)))
  2105.   if right(PO_Location, 1) == 'R' then call RightText(PO_ID, BoxLeft + BoxWidth - 2 * DateOffset)
  2106.  
  2107.   return PO_ID
  2108. /**/
  2109.  
  2110. /***//*******  PrintText (PT) Subroutine  ***********/
  2111. PrintText:
  2112.   parse arg PT_Left, PT_Top, PT_FontType, PT_Style, PT_Color, PT_Width, PT_Text
  2113.  
  2114.   if upper(PT_Style) == 'N' then PT_Font = Font.PT_FontType
  2115.   else PT_Font = Bold.PT_FontType
  2116.  
  2117.   if App == 'FW' then do
  2118.     if left(PT_Text, 1) == '"' then PT_Text = '""'PT_Text
  2119.     PT_Top = PT_Top + TextAdj * Height.PT_FontType
  2120.     TEXTBLOCKTYPEPREFS SIZE FSize.PT_FontType WIDTH trunc(PT_Width) COLOR '"'PT_Color'"' FONT PT_Font
  2121.     DRAWTEXTBLOCK 1 PT_Left PT_Top PT_Text; PT_id = result
  2122.   end
  2123.   else if App == 'PGS' then do
  2124.     DRAWTEXTOBJ PT_Left PT_Top WINDOW winName; PT_id = result
  2125.     SELECTTEXT AT PT_Left PT_Top WINDOW winName
  2126.     BEGINCOMMANDCAPTURE
  2127.       SETTYPESIZE FSize.PT_FontType WINDOW winName
  2128.       SETTYPEWIDTH PT_Width WINDOW winName
  2129.       SETFONT PT_Font WINDOW winName
  2130.       SETCOLORSTYLE '"'PT_Color'"' COLORNUMBER 0 FILL TEXT WINDOW winName
  2131.     ENDCOMMANDCAPTURE
  2132.     if pos('"', PT_Text) > 0 then do
  2133.       call open('IFile', Storage'Text2Insert.txt', 'W')
  2134.         call WriteLn('IFile', PT_Text)
  2135.       call close('IFile')
  2136.       INSERTTEXT FILE Storage'Text2Insert.txt' FILTER ASCII WINDOW winName
  2137.     end
  2138.     else INSERT '"'PT_Text'"' WINDOW winName
  2139.   end
  2140.   return PT_id
  2141. /**/
  2142.  
  2143. /***//*******  ReadData () Subroutine  ***********/
  2144. ReadData:
  2145.   call UpdateBusy(Req, 1)
  2146.   VarCount = 0
  2147.   SL       = 0
  2148.   ImageClassCount = 0
  2149.   if open('DataFile', ScriptDir''ChangesFile) then do
  2150.     do until eof('DataFile')
  2151.       Ln = ReadLn('DataFile')
  2152.       if Ln = '' then iterate
  2153.       VarName = strip(word(Ln, 1))
  2154.       VarStem = left(VarName, pos('.', VarName))
  2155.       Var.SL = VarName
  2156.       SL = SL + 1
  2157.       interpret Ln
  2158.       if (upper(left(VarName, 2)) == 'DO') |,
  2159.          (upper(left(VarName, 7)) == 'STORAGE') |,
  2160.          (upper(left(VarName, 7)) == 'MARGIN.') |,
  2161.          (upper(VarName) = 'ORIENTATION') then iterate
  2162.       if upper(VarStem) == 'IMAGECLASS.' then do
  2163.         ImageClassCount = ImageClassCount + 1
  2164.         ImageClass.ImageClassCount = upper(substr(word(Ln, 1), 12))
  2165.         ImageClass = ImageClass.ImageClassCount
  2166.         ImageFile.ImageClassCount = ImageClass.ImageClass
  2167.         if (pos('/', ImageFile.ImageClassCount) == 0) & (pos(':', ImageFile.ImageClassCount) == 0) then ImageFile.ImageClassCount = ScriptDir'Images/'ImageFile.ImageClassCount
  2168.       end
  2169.       VarName.VarCount = VarName
  2170.       VarCount = VarCount + 1
  2171.     end
  2172.     call close('DataFile')
  2173.   end
  2174.   else do
  2175.     call AddMsg('E', 'Unable to open 'ScriptDir''ChangesFile)
  2176.     call Cleanup
  2177.   end
  2178.  
  2179.   VarName.COUNT = VarCount
  2180.   if upper(Orientation) == 'WIDE' then OrientChoice = 0
  2181.   else OrientChoice = 1
  2182.  
  2183.   VarName = VarName.0
  2184.   VarVal  = VarVal.VarName
  2185.  
  2186.   call UpdateBusy(Req, 1)
  2187.   if (exists(SunCalcPath'suncalc')) & (~exists(Storage'suncalc')) then address command 'copy 'SunCalcPath'suncalc 'Storage
  2188.   if ~exists(Storage'suncalc') then DoSunCalc = 0
  2189.  
  2190.   call UpdateBusy(Req, 1)
  2191.   if (exists(GfxAppPath'Visage')) & (~exists(Storage'Visage')) then address command 'copy 'GfxAppPath'Visage 'Storage
  2192.   if ~exists(Storage'Visage') then DoImages = 0
  2193.  
  2194.   if MathLib ~= 1 then DoPhases = 0
  2195.   return
  2196. /**/
  2197.  
  2198. /***//*******  RightText (RT) Subroutine  ***********/
  2199. RightText:
  2200.   parse arg RT_id, RT_RightEdge
  2201.  
  2202.   if App = 'FW' then do
  2203.     GETOBJECTCOORDS RT_id; Parse Var result . . RT_Text.Bottom RT_Text.Width RT_Text.Height
  2204.     RT_Text.Left = RT_RightEdge - RT_Text.Width
  2205.     SETOBJECTCOORDS RT_id 1 RT_Text.Left RT_Text.Bottom RT_Text.Width RT_Text.Height
  2206.   end
  2207.   else if App == 'PGS' then do
  2208.     GETTEXTOBJ POSITION RT_Text OBJECTID RT_id WINDOW winName
  2209.     RT_Text.Width = RT_Text.Right - RT_Text.Left
  2210.     RT_Text.Left = RT_RightEdge - RT_Text.Width
  2211.     EDITTEXTOBJ POSITION RT_Text.Left RT_Text.Top (RT_Text.Left + RT_Text.Width) RT_Text.Bottom OBJECTID RT_id WINDOW winName
  2212.   end
  2213.   return RT_id
  2214. /**/
  2215.  
  2216. /***//*******  SaveVariable (SV) Subroutine  ***********/
  2217. SaveVariable:
  2218.   parse arg SV_OutFile, SV_Variable, SV_Value
  2219.  
  2220.   SV_Cmd = SV_Variable' = 'SV_Value
  2221.   call WriteLn(SV_OutFile, SV_Cmd)
  2222.   interpret SV_Cmd
  2223.  
  2224.   return
  2225. /**/
  2226.  
  2227. /***//*******  SetColor (SC) Subroutine  ***********/
  2228. SetColor:
  2229.   parse arg SC_ColorType
  2230.  
  2231.   interpret 'SC_Color = Color.'SC_ColorType
  2232.   VarName = 'AltColor.'SC_ColorType
  2233.   if symbol(VarName) == 'VAR' then return
  2234.   if SC_Color ~= Color. then do
  2235.     Var.SL = VarName
  2236.     Value.VarName = SC_Color
  2237.     SL = SL + 1
  2238.   end
  2239.   else SC_Color = Color.
  2240.  
  2241.   interpret VarName' = SC_Color'
  2242.  
  2243.   return
  2244. /**/
  2245.  
  2246. /***//*******  SetFill (SF) Subroutine  ***********/
  2247. SetFill:
  2248.   parse arg SF_ID, SF_StrokeColor, SF_FillColor
  2249.  
  2250.   BEGINCOMMANDCAPTURE
  2251.     SETSTROKEWEIGHT '0.3pt' STROKENUMBER 0 OBJECT OBJECTID SF_ID WINDOW winName
  2252.     SETCOLORSTYLE '"'SF_StrokeColor'"' STROKENUMBER 0 OBJECT OBJECTID SF_ID WINDOW winName
  2253.     FILLED 'ON'
  2254.     SETCOLORSTYLE '"'SF_FillColor'"' FILL OBJECT OBJECTID SF_ID WINDOW winName
  2255.   ENDCOMMANDCAPTURE
  2256.   return
  2257. /**/
  2258.  
  2259. /***//*******  SetHighlights (SH) Subroutine  ***********/
  2260. SetHighlights:
  2261. /* The algorithm for calculating Easter is due to J.-M. Oudin (1940) and is        */
  2262. /* reprinted in the Explanatory Supplement to the Astronomical Almanac, ed. P. K.  */
  2263. /* Seidelmann (1992). See Chapter 12, "Calendars", by L. E. Doggett.               */
  2264. /*                                                                                 */
  2265. /* I obtained the algorithm from the US Naval Observatory web site                 */
  2266.  
  2267.   SettingHighlights = 1
  2268.   SH_Progress = -2
  2269.   if EasterKnown ~= 1 then do
  2270.     SH_century = trunc(Year / 100)
  2271.     SH_n = trunc(Year - 19 * trunc(Year / 19))
  2272.     SH_k = trunc((SH_century - 17) / 25)
  2273.     SH_i = SH_century - trunc(SH_century / 4) - trunc((SH_century - SH_k) / 3) + 19 * SH_n + 15
  2274.     SH_i = SH_i - 30 * trunc(SH_i / 30)
  2275.     SH_i = SH_i - trunc(SH_i / 28) * (1 - trunc(SH_i / 28) * trunc(29 / (SH_i + 1)) * trunc((21 - SH_n) / 11))
  2276.     SH_j = Year + trunc(Year / 4) + SH_i + 2 - SH_century + trunc(SH_century / 4)
  2277.     SH_j = SH_j - 7 * trunc(SH_j / 7)
  2278.     SH_l = SH_i - SH_j
  2279.     SH_EasterMonth  = 3 + trunc((SH_l + 40 ) / 44)
  2280.     SH_EasterDay    = SH_l + 28 - 31 * trunc(SH_EasterMonth / 4)
  2281.     EasterSerial = DateInfo('I', Year'0'SH_EasterMonth''right(SH_EasterDay, 2, '0'), 'S')
  2282.     EasterKnown  = 1
  2283.   end
  2284.   Highlight. = ''
  2285.   Image.     = ''
  2286.  
  2287.   if symbol('HighlightStart') == 'VAR' then do
  2288.     call open('DataFile', ScriptDir''FWCData)
  2289.       call seek('DataFile', HighlightStart, 'B')
  2290.       do until eof('DataFile')
  2291.         SH_Ln = ReadLn('DataFile')
  2292.         SH_Ln2 = left(SH_Ln, 2)
  2293.         if upper(left(SH_Ln, 14)) == 'CALCULATEEDATE' then interpret 'call 'SH_Ln
  2294.         if (SH_Ln2 == Mn) | (SH_Ln2 == '13') then do
  2295.           SH_Progress = -SH_Progress
  2296.           call UpdateBusy(Req, SH_Progress)
  2297.           select
  2298.             when upper(substr(SH_Ln, 3, 13)) == 'CALCULATEDATE' then interpret 'call 'substr(SH_Ln, 3)
  2299.             when upper(substr(SH_Ln, 3, 9)) == 'HIGHLIGHT' then call AssignHighlight(substr(SH_Ln, 3))
  2300.             when upper(substr(SH_Ln, 3, 5)) == 'IMAGE' then call AssignImage(substr(SH_Ln, 3))
  2301.             when upper(substr(SH_Ln, 3, 14)) == 'CALCULATEIMAGE' then interpret 'call 'substr(SH_Ln, 3)
  2302.             otherwise do
  2303.               call AddMsg('W', 'Check the keyword in the following line of your FWCalendar.data file:')
  2304.               call AddMsg('W', '  'SH_Ln)
  2305.               ListHighlightData = 1
  2306.             end
  2307.           end
  2308.         end
  2309.       end
  2310.     call close('DataFile')
  2311.   end
  2312.  
  2313.   if DoEaster == 1 then call AssignHighlight(SH_EasterMonth, SH_EasterDay, Easter$'#')
  2314.   if sign(SH_Progress) == 1 then call UpdateBusy(Req, -SH_Progress)
  2315.   SettingHighlights = 0
  2316. return
  2317. /**/
  2318.  
  2319. /***//*******  Syntax () Subroutine  ***********/
  2320. Syntax:
  2321.   signal off syntax
  2322.  
  2323.   ErrorLine  = SIGL
  2324.   SourceLine = strip(SourceLine(ErrorLine))
  2325.   if SourceLine = 'bguiopen = bguiopen()' then do
  2326.     bguiopen = 0
  2327.     call AddMsg('E', 'Could not open bgui functions. Check versions:')
  2328.     call AddMsg('E', '  bgui.library v41+')
  2329.     call AddMsg('E', '  rexxbgui.library v4+')
  2330.     call Cleanup
  2331.   end
  2332.  
  2333.   call AddMsg('E', 'Error 'RC' ('errortext(RC)')')
  2334.   call AddMsg('E', 'Line 'ErrorLine': 'SourceLine)
  2335.   call AddMsg('E', ParseVariables(SourceLine))
  2336.  
  2337.   call Cleanup
  2338.   exit
  2339. /**/
  2340.  
  2341. /***//*******  TestSettings (TS) Subroutine  ***********/
  2342. TestSettings:
  2343.   if App == 'FW' then do
  2344.     do TS_j = 0 to ColorCount
  2345.       FONTCOLOR '"'value(ColorName.TS_j)'"'
  2346.       TYPE TS_j
  2347.       STATUS FONTCOLOR; TS_CurrentColor = result
  2348.       if TS_CurrentColor ~= value(ColorName.TS_j) then call AddMsg('E', '"'value(ColorName.TS_j)'", used for 'ColorName.TS_j', is not understood.')
  2349.     end
  2350.     do TS_i = 0 to FontCount
  2351.       FONT '"'Font.TS_i'"'
  2352.       TYPE TS_i
  2353.       STATUS FONTPATH; TS_CurrentFont = result
  2354.       if NameOnly(Font.TS_i) ~= NameOnly(TS_CurrentFont) then call AddMsg('E', '"'Font.TS_i'", used for Font.'FontName.TS_i', is not understood.')
  2355.     end
  2356.     SELECTALL
  2357.     DELETE
  2358.   end
  2359.   else if App == 'PGS' then do
  2360.     GETFONTLIST TS_FontList; TS_FontListCount = result - 1
  2361.     do TS_j = 0 to ColorCount
  2362.       do TS_i = 0 to TS_FontListCount
  2363.         if Font.TS_j = TS_FontList.TS_i then leave
  2364.       end
  2365.       if TS_i > TS_FontListCount then call AddMsg('W', Font.TS_J', used for Font.'FontName.TS_J', is not in your fontlist.')
  2366.     end
  2367.   end
  2368. return
  2369. /**/
  2370.  
  2371. /***//*******  UpdateBusy (UB) Subroutine  ***********/
  2372. UpdateBusy:
  2373.   parse arg UB_ReqWin, UB_ProgressMade
  2374.  
  2375.   if UB_ReqWin == 0 then return
  2376.   Progress = Progress + UB_ProgressMade
  2377.  
  2378.   call bguiset(obj.OB_prog2_,UB_ReqWin,PROGRESS_Done,Progress)
  2379.   if bguiwinevent(UB_ReqWin,'ID') == id.OB_cancel_ then call Cleanup
  2380.  
  2381.   return
  2382. /**/
  2383.  
  2384. /***//*******  WriteData (WD) Subroutine  ***********/
  2385. WriteData:
  2386.   if open('DataFile', ScriptDir''ChangesFile, 'W') then do
  2387.     do i = 0 to SL - 1
  2388.       VarName = Var.i
  2389.       Value = Value(VarName)
  2390.       if (datatype(Value) == 'CHAR') then Value = "'"Value"'"
  2391.       call writeln('DataFile', VarName' = 'Value)
  2392.     end
  2393.     call close('DataFile')
  2394.   end
  2395.   else do
  2396.     call AddMsg('E', 'Unable to create 'ScriptDir''ChangesFile)
  2397.     call Cleanup
  2398.   end
  2399.  
  2400.   return
  2401. /**/
  2402.  
  2403. /***//*******  SetVariable Subroutine  ***********/
  2404. SetVariables:
  2405.   If RequesterVariables ~= 1 then do
  2406.  
  2407. /***//* Initialize Variables */
  2408.     ColorVars         = 'color. line. background.'
  2409.     CountJulian       = 0
  2410.     CountJulianLeft   = 0
  2411.     CountSunRise      = 0
  2412.     CountSunSet       = 0
  2413.     CountPhases       = 0
  2414.     DoHide            = 0
  2415.     DoShanghai        = 1
  2416.     Error             = 0
  2417.     FSize.            = 10
  2418.     FWCData           = 'FWCalendar.data'
  2419.     ChangesFile       = 'FWC.dat'
  2420.     HighlightCount    = 0
  2421.     ImageClassCount   = 0
  2422.     ImageCount        = 0
  2423.     ImageSize.        = ''
  2424.     LF                = '0a'x
  2425.     MoonPhase.        = ''
  2426.     NULL              = '00'x
  2427.     OB_ProgressWindow = ''
  2428.     Req               = 0
  2429.     ShiftLMini.       = 0
  2430.     ShiftRMini.       = 0
  2431.     Storage           = 'RAM:FWC/'
  2432.     Text.             = ''
  2433.     TextAdj           = 0.77
  2434.     TTextArea         = 0.15
  2435.     WTextArea         = 0.20
  2436.     UserPrefs         = ''
  2437.     Width.            = 100
  2438.  
  2439.     PGSFilter.     = ''
  2440.     PGSFilter.ILBM = 'IFFILBM'
  2441.     PGSFilter.JFIF = 'JPEG'
  2442.     PGSFilter.gif  = 'GIF'
  2443.  
  2444.     Action.0       = 'MX_EnableButton'
  2445.     Action.1       = 'MX_DisableButton'
  2446.     GroupCount     = 4
  2447.  
  2448.     pos.0 = 'BL' ; grp.0 = 'obj.bottomleft_'
  2449.     pos.1 = 'BC' ; grp.1 = 'obj.bottomcenter_'
  2450.     pos.2 = 'BR' ; grp.2 = 'obj.bottomright_'
  2451.     pos.3 = 'TC' ; grp.3 = 'obj.topcenter_'
  2452.     pos.4 = 'TR' ; grp.4 = 'obj.topright_'
  2453.  
  2454.     Do.1 = 'Phases'     ; MXPos.Phases     = 1
  2455.     Do.2 = 'Weeknumber' ; MXPos.Weeknumber = 2
  2456.     Do.3 = 'Julian'     ; MXPos.Julian     = 3
  2457.     Do.4 = 'JulianLeft' ; MXPos.JulianLeft = 4
  2458.     Do.5 = 'BothJ'      ; MXPos.BothJ      = 5
  2459.     Do.6 = 'Sunrise'    ; MXPos.Sunrise    = 6
  2460.     Do.7 = 'Sunset'     ; MXPos.Sunset     = 7
  2461.     Do.8 = 'BothS'      ; MXPos.BothS      = 8
  2462.  
  2463.     ColorName.0 = 'Color.'
  2464.     ColorName.1 = 'Color.White'
  2465.     ColorName.2 = 'Line.'
  2466.     ColorName.3 = 'Background.'
  2467.     ColorCount  = 3
  2468.  
  2469.     if App == 'FW' then do
  2470.       Font. = 'FWFonts/SWOLFonts/SoftSans'
  2471.       Bold. = 'FWFonts/SWOLFonts/SoftSans_Bold'
  2472.     end
  2473.     else if App == 'PGS' then do
  2474.       Font. = 'Helvetica-Normal'
  2475.       Bold. = 'Helvetica-Bold'
  2476.     end
  2477.  
  2478.     Date      = 0
  2479.     Weekday   = 1
  2480.     Header    = 2
  2481.     MiniCal   = 3
  2482.     FYMiniCal = 4
  2483.     Highlight = 5
  2484.  
  2485.     FontName.0 = 'Date'
  2486.     FontName.1 = 'Weekday'
  2487.     FontName.2 = 'Header'
  2488.     FontName.3 = 'MiniCal'
  2489.     FontName.4 = 'FYMiniCal'
  2490.     FontName.5 = 'Highlight'
  2491.     FontCount  = 5
  2492.  
  2493.     BoldName.0 = 'Date'
  2494.     BoldName.1 = 'Weekday'
  2495.     BoldName.2 = 'Header'
  2496.     BoldName.3 = 'MiniCal'
  2497.     BoldName.4 = 'FYMiniCal'
  2498.     BoldName.5 = 'Highlight'
  2499.     BoldCount  = 5
  2500.  
  2501.     Backgrounds$   = 'Backgrounds'
  2502.     Black$         = 'Black'
  2503.     Bottom$        = 'Bottom'
  2504.     BoxDates$      = 'Box Dates'
  2505.     Calendar$      = 'Calendar'
  2506.     Cancel$        = '_Cancel'
  2507.     Center$        = 'Center'
  2508.     Easter$        = 'Easter'
  2509.     Extended$      = 'Extended'
  2510.     Generating$    = 'Generating'
  2511.     Highlights$    = 'Highlights'
  2512.     Images$        = 'Images'
  2513.     Julian$        = 'Julian'
  2514.     JulJulLeft$    = 'Jul/Jul Left'
  2515.     JulLeft$       = 'Jul Left'
  2516.     Left$          = 'Left'
  2517.     MiniCals$      = 'MiniCals'
  2518.     MiscVar$       = 'Miscellaneous Variables'
  2519.     Monthly$       = '_Monthly'
  2520.     None$          = 'None'
  2521.     OK$            = '_OK'
  2522.     OptLayout$     = 'Options & Layout'
  2523.     OrientMarg$    = 'Orientation & Margins'
  2524.     Phases$        = 'Phases'
  2525.     PleaseWait$    = 'Please wait'
  2526.     PrepReq$       = 'Preparing requester'
  2527.     Reset$         = '_Reset'
  2528.     Right$         = 'Right'
  2529.     RiseSet$       = 'Rise/Set'
  2530.     Sunrise$       = 'Sunrise'
  2531.     Sunset$        = 'Sunset'
  2532.     Tall$          = 'Tall'
  2533.     Top$           = 'Top'
  2534.     VarGUITitle$   = 'Set desired variables:'
  2535.     Weeknumber$    = 'Weeknumber'
  2536.     White$         = 'White'
  2537.     WholeYear$     = 'Whole _Year'
  2538.     Wide$          = 'Wide'
  2539.  
  2540.     January$   = 'January'
  2541.     February$  = 'February'
  2542.     March$     = 'March'
  2543.     April$     = 'April'
  2544.     May$       = 'May'
  2545.     June$      = 'June'
  2546.     July$      = 'July'
  2547.     August$    = 'August'
  2548.     September$ = 'September'
  2549.     October$   = 'October'
  2550.     November$  = 'November'
  2551.     December$  = 'December'
  2552.  
  2553.     Sunday$    = 'Sunday'
  2554.     Monday$    = 'Monday'
  2555.     Tuesday$   = 'Tuesday'
  2556.     Wednesday$ = 'Wednesday'
  2557.     Thursday$  = 'Thursday'
  2558.     Friday$    = 'Friday'
  2559.     Saturday$  = 'Saturday'
  2560.  
  2561.     D.0 = 'Sunday'
  2562.     D.1 = 'Monday'
  2563.     D.2 = 'Tuesday'
  2564.     D.3 = 'Wednesday'
  2565.     D.4 = 'Thursday'
  2566.     D.5 = 'Friday'
  2567.     D.6 = 'Saturday'
  2568.  
  2569.     MonthLength.1  = 31
  2570.     MonthLength.2  = 28
  2571.     MonthLength.3  = 31
  2572.     MonthLength.4  = 30
  2573.     MonthLength.5  = 31
  2574.     MonthLength.6  = 30
  2575.     MonthLength.7  = 31
  2576.     MonthLength.8  = 31
  2577.     MonthLength.9  = 30
  2578.     MonthLength.10 = 31
  2579.     MonthLength.11 = 30
  2580.     MonthLength.12 = 31
  2581. /**/
  2582.  
  2583.     ProcessNow = 'WhiteName BlackName DoShanghai DoHide Storage'
  2584.  
  2585.     if exists(ScriptDir''FWCData) then do
  2586.       if open('DataFile', ScriptDir''FWCData) then do
  2587.         do until eof('DataFile')
  2588.           Ln = ReadLn('DataFile')
  2589.           if pos(upper(word(Ln, 1)), upper(ProcessNow)) ~= 0 then interpret Ln
  2590.           else if right(word(Ln, 1), 1) == '$' then interpret Ln
  2591.           else if left(Ln, 15) == '/* End Pass One' then do
  2592.             HighlightStart = seek('DataFile', 0)
  2593.             leave
  2594.           end
  2595.         end
  2596.         call close('DataFile')
  2597.       end
  2598.     end
  2599.  
  2600.     call makedir(left(Storage, length(Storage) - 1))
  2601.  
  2602.     if Symbol('BlackName') == 'VAR' then Black$ = BlackName
  2603.     if Symbol('WhiteName') == 'VAR' then White$ = WhiteName
  2604.  
  2605.     Color.       = Black$
  2606.     Line.        = Black$
  2607.     Background.  = White$
  2608.  
  2609.     Month.1  = January$
  2610.     Month.2  = February$
  2611.     Month.3  = March$
  2612.     Month.4  = April$
  2613.     Month.5  = May$
  2614.     Month.6  = June$
  2615.     Month.7  = July$
  2616.     Month.8  = August$
  2617.     Month.9  = September$
  2618.     Month.10 = October$
  2619.     Month.11 = November$
  2620.     Month.12 = December$
  2621.  
  2622.     AppScreen = ''
  2623.     DefScreen = ''
  2624.     if (RexxTricks == 1) & (DoShanghai ~= 0) then do
  2625.       if (pubscreenlist('ScreenList') > 0) then do
  2626.         do i = 1 to ScreenList.0
  2627.           if pos(AppName, upper(ScreenList.i)) > 0 then do
  2628.             AppScreen = ScreenList.i
  2629.             DefScreen = setdefaultpubscreen(AppScreen)
  2630.             leave
  2631.           end
  2632.         end
  2633.       end
  2634.     end
  2635.  
  2636.     RequesterVariables = 1
  2637.     VarLoc = VarListLoc()
  2638.     return
  2639.   end
  2640.  
  2641.   CNotice     = 'Created w/ FWCalendar © Ron Goertz'
  2642.   Color.White = White$
  2643.   FSize.4pt   = 4
  2644.  
  2645.   ColorValue.0 = color.
  2646.   ColorValue.1 = color.white
  2647.   ColorValue.2 = line.
  2648.   ColorValue.3 = background.
  2649.  
  2650.   DoJulian       = upper(DoJulian)
  2651.   DoJulianLeft   = upper(DoJulianLeft)
  2652.   ShiftLMini.App = ShiftLMini.App / 720
  2653.   ShiftRMini.App = ShiftRMini.App / 720
  2654.  
  2655.   if (MathLib ~= 1) & (DoPhases ~= 0) then do
  2656.     call AddMsg('W', 'rexxmathlib.library is required to calculate the moon phases.')
  2657.     DoPhases = 0
  2658.   end
  2659.  
  2660.   do i = 0 to 6
  2661.     val = i - StartWeek
  2662.     if val < 0 then val = 7 + val
  2663.     interpret 'Day.'D.i '=' val
  2664.     interpret 'Day.val = 'D.i'$'
  2665.   end
  2666.  
  2667.   if App == 'FW' then do
  2668.     MiniCalFactor = 29
  2669.  
  2670.     PAGESETUP ORIENT Orientation
  2671.     if Orientation == 'WIDE' then TextArea = WTextArea
  2672.     else TextArea = TTextArea
  2673.  
  2674.     GETDISPLAYPREFS Measure; UserPrefs = 'DISPLAYPREFS Measure 'result
  2675.     DISPLAYPREFS Measure Inches
  2676.     SECTIONSETUP TOP Margin.Top BOTTOM Margin.Bottom INSIDE Margin.Left OUTSIDE Margin.Right
  2677.     GETPAGESETUP Width Height
  2678.     parse var result FullWidth FullHeight
  2679.   end
  2680.   else if App = 'PGS' then do
  2681.     getdocuments dummy; DocCount = result
  2682.     if DocCount > 0 then DoHide = 0
  2683.  
  2684.     MiniCalFactor = 34
  2685.     if Orientation == 'WIDE' then do
  2686.       TextArea = WTextArea
  2687.       Orientation = 'LANDSCAPE'
  2688.     end
  2689.     else do
  2690.       TextArea = TTextArea
  2691.       Orientation = 'PORTRAIT'
  2692.     end
  2693.  
  2694.     if CalType == 1 then DocName = '"'EnteredYear''Mn''Calendar$'"'
  2695.     else DocName = '"'EnteredYear''Calendar$'"'
  2696.     PageName = '"FWCalendar by Ron Goertz"'
  2697.     NEWDOCUMENT DocName
  2698.     NEWMASTERPAGE PageName PageWidth PageHeight SINGLE Orientation
  2699.     SETMARGINGUIDES Margin.Left Margin.Right Margin.Top Margin.Bottom MASTERPAGE PageName
  2700.     SETDIMENSIONS PageWidth PageHeight SINGLE Orientation MASTERPAGE PageName
  2701.     SETCOLUMNGUIDES 0 0 MASTERPAGE PageName
  2702.     SETDOCUMENTSTATUS unchanged DOCUMENT DocName
  2703.     OPENWINDOW '"View 1"' DOCUMENT DocName PAGE 1
  2704.     GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro
  2705.     UserPrefs = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
  2706.     SETMEASUREMENTS COORDINATE Inches Sameas RELATIVE Sameas TEXT Points FROM Page
  2707.     GETMARGINGUIDES temp MASTERPAGE PageName
  2708.     if rc == 0 then do
  2709.       Margin.Left   = temp.inside
  2710.       Margin.Right  = temp.outside
  2711.       Margin.Top    = temp.top
  2712.       Margin.Bottom = temp.bottom
  2713.     end
  2714.     GETDIMENSIONS temp MASTERPAGE PageName
  2715.     CmdSuccess = rc
  2716.     if Orientation = 'LANDSCAPE' then do
  2717.       if CmdSuccess == 0 then do
  2718.         FullWidth  = temp.height
  2719.         FullHeight = temp.width
  2720.       end
  2721.       else do
  2722.         FullWidth  = PageHeight
  2723.         FullHeight = PageWidth
  2724.       end
  2725.     end
  2726.     else do
  2727.       if CmdSuccess == 0 then do
  2728.         FullWidth  = temp.width
  2729.         FullHeight = temp.height
  2730.       end
  2731.       else do
  2732.         FullWidth  = PageWidth
  2733.         FullHeight = PageHeight
  2734.       end
  2735.     end
  2736.     CURRENTWINDOW; winName = '"'RESULT'"'
  2737.   end
  2738.   PrintWidth  = FullWidth - Margin.Left - Margin.Right
  2739.   PrintHeight = FullHeight - Margin.Top - Margin.Bottom
  2740.  
  2741.  
  2742.   if CalType == 1 then do
  2743.     if App == 'FW' then do
  2744.       TEXTBLOCKTYPEPREFS SIZE 4 WIDTH 100 COLOR Color.White FONT Font.Highlight
  2745.       DRAWTEXTBLOCK 1 0 0 'TempDate'; ID = result /* id should be 2 */
  2746.       GetObjectCoords ID; Parse Var result . . . . Height.4pt
  2747.     end
  2748.     else if App == 'PGS' then Height.4pt = GetHeight(4pt)
  2749.  
  2750.     if ((PrintHeight - Height.4pt - (TextArea * PrintHeight))/5 * 8) >= 4 then do
  2751.       DoCopyright = 1
  2752.       PrintHeight = PrintHeight - Height.4pt
  2753.     end
  2754.     else DoCopyright = 0
  2755.  
  2756.     BoxWidth    = PrintWidth/7
  2757.     CalRight    = Margin.Left + BoxWidth * 7
  2758.  
  2759.     TextArea        = TextArea * PrintHeight
  2760.     CalTop          = TextArea + Margin.Top
  2761.     BoxHeight       = (PrintHeight - TextArea)/5
  2762.     MoonRadius      = BoxHeight * MoonRadius
  2763.     DateOffset      = DateOffset * BoxWidth
  2764.     MiniCalHeight   = TextArea * MiniCalHeight
  2765.     MiniCalWidth    = MiniCalHeight * MiniCalWidth
  2766.  
  2767.     FSize.Highlight = BoxHeight/HighlightRows * 72
  2768.     FSize.Date      = BoxHeight * 8 * StretchDateH
  2769.     Width.Date      = Width.Date * StretchDateW / StretchDateH
  2770.     FSize.Weekday   = (TextArea - MiniCalHeight)/2 * 72
  2771.     FSize.Header    = TextArea/2 * 72
  2772.  
  2773.     if App == 'FW' then do
  2774.       FSize.MiniCal  = MiniCalHeight/6 * 72
  2775.       do i = 0 to 5
  2776.         FSize.i = min(max(trunc(FSize.i), 4), 360)
  2777.         Width.i = min(max(trunc(Width.i), 4), 255)
  2778.       end
  2779.     end
  2780.     else if App == 'PGS' then FSize.MiniCal  = MiniCalHeight/7 * 72
  2781.  
  2782.     Height.Highlight = GetHeight(Highlight)
  2783.     Height.Date      = GetHeight(Date)
  2784.     Height.Weekday   = GetHeight(Weekday)
  2785.     Height.Header    = GetHeight(Header)
  2786.     Height.MiniCal   = GetHeight(MiniCal)
  2787.   end
  2788.   else do
  2789.     Height.4pt = GetHeight(4pt)
  2790.  
  2791.     if ((PrintHeight - Height.4pt - 3 * MiniCalSpacing)/MiniCalFactor * 72) >= 4 then do
  2792.       DoCopyright = 1
  2793.       PrintHeight = PrintHeight - Height.4pt
  2794.     end
  2795.     else DoCopyright = 0
  2796.  
  2797.     MiniCalSpacing  = MiniCalSpacing * PrintWidth
  2798.     MiniCalWidth    = (PrintWidth - 2 * MiniCalSpacing)/3
  2799.  
  2800.     FSize.FYMiniCal = (PrintHeight - 3 * MiniCalSpacing)/MiniCalFactor * 72
  2801.     if App == 'FW' then FSize.FYMiniCal = max(trunc(FSize.FYMiniCal), 4)
  2802.     Height.FYMiniCal = GetHeight(FYMiniCal)
  2803.   end
  2804.  
  2805.   if App == 'FW' then TextBlockPrefs TEXTFLOW None
  2806.  
  2807.   VariablesSet = 1
  2808.   if TestMode = 1 then call TestSettings
  2809.   if ErrorCount > 0 then call Cleanup
  2810. return
  2811. /**/
  2812.  
  2813. /***//*******  VarList () Subroutine  ***********/
  2814. ReturnVarListLoc:
  2815.   return SIGL + 2
  2816. VarListLoc:
  2817.   /* WTextArea      = fraction of print height used for top of calendar (Wide) */
  2818.   /* TTextArea      = fraction of print height used for top of calendar (Tall) */
  2819.   /* DateOffset     = fraction of box width to offset dates from edge of box   */
  2820.   /* MiniCalHeight  = fraction of text area height used for minicals           */
  2821.   /* MiniCalWidth   = width-to-height ratio for minicals                       */
  2822.   /* MiniCalSpacing = fraction of print width placed between FY minicals       */
  2823.   signal ReturnVarListLoc
  2824. VarList:
  2825.   AdjustDST      = 1
  2826.   BelzierFactor  = .55
  2827.   DateOffset     = 0.02
  2828.   DoBackgrounds  = 0
  2829.   DoDateBox      = 0
  2830.   DoEaster       = 1
  2831.   DoExtended     = 1
  2832.   DoHighlights   = 1
  2833.   DoImages       = 0
  2834.   DoJulian       = 0
  2835.   DoJulianLeft   = 0
  2836.   DoMiniCals     = 1
  2837.   DoPhases       = 0
  2838.   DoSunRise      = 0
  2839.   DoSunSet       = 0
  2840.   DoWeekNumber   = 0
  2841.   FinalView      = 75
  2842.   Font.Date      = Font.
  2843.   Font.Highlight = Font.
  2844.   Font.Weekday   = Font.
  2845.   Font.Header    = Font.
  2846.   Font.MiniCal   = Font.
  2847.   GfxAppPath     = ''
  2848.   HeaderLoc      = 2
  2849.   HighlightRows  = 9
  2850.   LaunchM        = ''
  2851.   LaunchY        = ''
  2852.   Margin.Left    = 0
  2853.   Margin.Top     = 0
  2854.   Margin.Right   = 0
  2855.   Margin.Bottom  = 0
  2856.   MaxImgHeight   = .75
  2857.   MaxImgWidth    = .75
  2858.   MiniCalHeight  = 0.60
  2859.   MiniCalSpacing = 0.005
  2860.   MiniCalWidth   = 2.00
  2861.   MoonRadius     = .1
  2862.   Orientation    = 'WIDE'
  2863.   ShiftLMini.FW  = 0
  2864.   ShiftLMini.PGS = 0
  2865.   ShiftRMini.FW  = 0
  2866.   ShiftRMini.PGS = 0
  2867.   StartWeek      = 0
  2868.   StretchDateH   = 1
  2869.   StretchDateW   = 1
  2870.   SunCalcPath    = ''
  2871.   TestMode       = 0
  2872. return
  2873. /**/
  2874.  
  2875.